Le blog de erca57 » Prog. Orientée Objets

Persistance des objets par SQL : créer une base

erca57 — Thu, 05 Feb 2009 10:17:49 +0000

16e pisode

2.2.6 – Créer une nouvelle base de données

Nous pouvons maintenant gérer les personnes dans une table PEOPLE. Ce que nous ne pouvons pas faire, c’est créer un nouveau fichier de base de données de la même façon que nous avons créé de nouveaux fichiers-textes. Nous allons donc rajouter cette fonctionnalité à notre application.

procedure TFormRepert.aNewExecute(Sender: TObject);
begin
if not(ExtractFileExt(CurrentFileName) = '.fdb') then
if (MessageDlg('Voulez-vous enregistrer le fichier courant ?',
mtWarning, [mbYes, mbNo], 0) = mrYes)
then
aSaveExecute(Sender);
People.Clear;
ListBox1.Clear;
SaveDialog1.InitialDir := ExtractFilePath(CurrentFileName);
if SaveDialog1.Execute then
CurrentFileName := SaveDialog1.FileName;
if ExtractFileExt(CurrentFileName) = '.fdb' then begin
Visitor := TSQLCreatePeople.Create;
try
People.AcceptBizObjVisitor(Visitor);
finally
Visitor.Free;
end;
Self.Caption := ExtractFileName(CurrentFileName);
aSave.Enabled := False;
aSaveAs.Enabled := False;
end;
end;

Si à partir de l’interface nous demandons à créer un nouveau fichier, nous devrons maintenant définir le nom du fichier. Si ce fichier est un fichier Firebird (extension .fdb), nous appliquons le visiteur TSQLCreatePeople à People, ce qui a pour effet de créer une nouvelle base de données dans sa méthode Create. Nous prenons soin d’afficher le nouveau nom de fichier dans l’interface et nous désactivons les actions de sauvegarde.

Pour que la nouvelle base soit créée, nous modifions la méthode TSQLFirebird.Create comme suit:

constructor TSQLFirebird.Create(var aFileName: TFileName);
begin
// aFileName must have .fdb extension
if ExtractFileExt(aFileName) <> '.fdb' then
ChangeFileExt(aFileName, '.fdb');
FDatabaseName := aFileName;
inherited Create(aFileName);
//connexion à la base de données
FDB := TIBDatabase.Create(nil);
with FDB do
begin
DatabaseName := FDatabaseName;
Params.Clear;
if FileExists(FDatabaseName) then
begin
Params.Add('user_name=SYSDBA');
Params.Add('password=cm5z2p3r');
end
else begin
Params.Add('USER ''SYSDBA''');
Params.Add('PASSWORD ''cm5z2p3r''');
Params.Add('PAGE_SIZE 4096');
FDB.CreateDatabase;
end;
LoginPrompt := False;
Connected := True;
end;
...//la suite est inchangée

end;

Ensuite le visiteur se charge de créer la table PEOPLE. Il nous suffit pour cela de définir la méthode Init puis d’appeler la méthode VisitBizObj de l’ancêtre TSQLCreate.

{
******************************* TSQLCreatePeople *******************************
}
procedure TSQLCreatePeople.Init;
begin
FQuery.SQL.Clear;
FQuery.SQL.Add('CREATE TABLE PEOPLE (');
FQuery.SQL.Add('OID INTEGER,');
FQuery.SQL.Add('LastName VARCHAR(20),');
FQuery.SQL.Add('FirstName VARCHAR(20),');
FQuery.SQL.Add('BirthDate DATE);');
end;

procedure TSQLCreatePeople.SetupParams;
begin
//no params
end;

procedure TSQLCreatePeople.VisitBizObj(Visited: TBizObj);
begin
if not(Visited is TPeople) then
Exit;
inherited VisitBizObj(Visited);
end;

{
********************************** TSQLCreate **********************************
}
procedure TSQLCreate.VisitBizObj(Visited: TBizObj);
begin
inherited VisitBizObj(Visited);
Init; // Set the SQL. Implemented in the concrete class
FQuery.ExecSQL;
end;

Persistance des objets par SQL : suppression

erca57 — Wed, 04 Feb 2009 10:01:37 +0000

14e épisode

2.2.4 – Visiteur TSQLDeletePerson

Pour effacer un objet TPerson de la base de données, nous créons le visiteur TSQLDeletePerson. Il est construit sur le même modèle que TSQLUpdatePerson et ne fait que redéfinir les méthodes Init et SetupParams:

{
******************************* TSQLDeletePerson *******************************
}
procedure TSQLDeletePerson.Init;
begin
FQuery.SQL.Clear;
FQuery.SQL.Add('DELETE FROM PEOPLE');
FQuery.SQL.Add('WHERE OID = :OID;');
end;

procedure TSQLDeletePerson.SetupParams;
var
IData: TPerson;
begin
IData := TPerson(FVisited);
FQuery.Params.ParamByName('OID').AsInteger := IData.OID;
end;

Le visiteur est appliqué à l’objet TPerson à effaçer comme suit:

procedure TFormRepert.aDeleteExecute(Sender: TObject);
var
aPerson: TPerson;
Visitor: TSQLDeletePerson;
begin
if ListBox1.ItemIndex < 0 then begin
MessageDlg('Sélectionnez une ligne', mtError, [mbOK], 0);
Exit;
end;
aPerson := TPerson(People.List.Items[ListBox1.ItemIndex]);
aPerson.State := bosDeleted;
if (MessageDlg('Effacer "'+ListBox1.Items[ListBox1.ItemIndex]+'" ?',
mtConfirmation, [mbYes,mbNo], 0) = mrYes)
then begin
if ExtractFileExt(CurrentFileName) = '.fdb' then begin
aPerson.State := bosDelete;
Visitor := TSQLDeletePerson.Create(CurrentFileName);
try
aPerson.AcceptBizObjVisitor(Visitor);
finally
Visitor.Free;
end;
end;
if aPerson.State = bosDeleted then
People.List.Delete(ListBox1.ItemIndex);
DisplayList;
end;
end;

Persistance des objets par SQL : insertion

erca57 — Wed, 04 Feb 2009 10:14:24 +0000

15e épisode

2.2.5 – Visiteur TSQLInsertPerson

L’insertion dans la base d’un nouvel objet TPerson ne différe pas beaucoup de la mise à jour.

{
******************************* TSQLInsertPerson *******************************
}
procedure TSQLInsertPerson.Init;
begin
FQuery.SQL.Clear;
FQuery.SQL.Add('INSERT INTO PEOPLE VALUES (');
FQuery.SQL.Add(':OID,');
FQuery.SQL.Add(':LastName,');
FQuery.SQL.Add(':FirstName,');
FQuery.SQL.Add(':BirthDate);');
end;

procedure TSQLInsertPerson.SetupParams;
var
IData: TPerson;
begin
IData := TPerson(FVisited);
FQuery.Params.ParamByName('OID').AsInteger := IData.OID;
FQuery.Params.ParamByName('LastName').AsString := IData.LastName;
FQuery.Params.ParamByName('FirstName').AsString := IData.FirstName;
FQuery.Params.ParamByName('BirthDate').AsDateTime := IData.BirthDate;
end;

Ce nouveau visiteur est appliqué à l’objet TPerson comme suit :

procedure TFormRepert.aCreateExecute(Sender: TObject);
var
newPerson: TPerson;
Visitor: TSQLInsertPerson;
begin
newPerson := TPerson.Create;
TFormPerson.Execute(newPerson);
if newPerson = nil then
Exit;
if newPerson.Dirty then
begin
if not(ExtractFileExt(CurrentFileName) = '.fdb') then
newPerson.Dirty := False
else begin
Visitor := TSQLInsertPerson.Create(CurrentFileName);
try
newPerson.AcceptBizObjVisitor(Visitor);
finally
Visitor.Free;
end;
end;
if not newPerson.Dirty then
People.Add(newPerson);
DisplayList;
end
else
newPerson.Free;
end;

Persistance des objets par SQL : mise à jour

erca57 — Wed, 04 Feb 2009 09:49:56 +0000

13e épisode

Nous avons décidé d’écrire chaque objet de la classe TPerson dans la base au fur et à mesure de sa création, de sa modification ou de sa suppression. Nous pourrions très bien mettre à jour la base de données au moment de quitter l’application, comme nous l’avons fait pour les fichiers-textes, mais avec le risque de perdre toutes nos mises à jour en cas de plantage. On accède aux fichiers-textes séquentiellement, ce qui ne permet pas la modification, l’insertion ou la suppression d’une ligne sans réécrire tout le fichier. C’est pourquoi nous écrivons les fichiers-textes en une seule fois au moment de quitter l’application. Par contre, une base de données SQL est spécialement conçue pour permettre l’accès direct à une ligne d’une table. Autant en profiter, et effectuer la mise à jour à chaque modification d’un objet TPerson.

2.2.3 – Visiteur TSQLUpdatePerson

Pour permettre la mise à jour de chaque objet TPerson, nous créons une nouvelle hiérarchie de classes.

Pour commencer, nous allons écrire le visiteur chargé de la mise à jour d’un enregistrement de la table People.

TSQLUpdatePerson -> TSQLWritePerson -> TSQLWrite -> TSQLFirebird -> TBizObjVisitor

Rappelons que :
– TBizObjVisitor stocke la référence de l’objet appelant (FVisited) et implémente la méthode Finalize qui met à jour l’état de l’objet;
– TSQLFirebird gère la connexion à la base dans le constructeur et le destructeur.

Trois nouvelles classes sont apparues:
– TSQLWrite implémente VisitBizObj(Visited:TBizObj) qui exécute les méthodes Init et SetupParams du visiteur dans l’ordre adéquat;
– TSQLWritePerson vérifie que l’objet visité est bien de la classe TPerson (dans VisitBizObj);
– TSQLUpdatePerson implémente Init et SetupParams.

TBizObjVisitor et TSQLFirebird ont déjà été décrits précédemment. Voyons les trois autres:

- TSQLWrite

procedure TSQLWrite.VisitBizObj(Visited: TBizObj);
begin
inherited VisitBizObj(Visited);
Init; //implémenté dans TSQLUpdatePerson
SetupParams; //implémenté dans TSQLUpdatePerson
FQuery.ExecSQL;
Finalize; // implémenté dans TBizObjVisitor
end;

- TSQLWritePerson

procedure TSQLWritePerson.VisitBizObj(Visited: TBizObj);
begin
if not(Visited is TPerson) then
Exit;
inherited VisitBizObj(Visited); //ci-dessus dans TSQLWrite
end;

- TSQLUpdatePerson

procedure TSQLUpdatePerson.Init;
begin
FQuery.SQL.Clear;
FQuery.SQL.Add('UPDATE PEOPLE SET');
FQuery.SQL.Add('LastName = :LastName,');
FQuery.SQL.Add('FirstName = :FirstName,');
FQuery.SQL.Add('BirthDate = :BirthDate');
FQuery.SQL.Add('WHERE OID = :OID;');
end;

procedure TSQLUpdatePerson.SetupParams;
var
IData: TPerson;
begin
IData := TPerson(FVisited);
FQuery.Params.ParamByName('OID').AsInteger := IData.OID;
FQuery.Params.ParamByName('LastName').AsString := IData.LastName;
FQuery.Params.ParamByName('FirstName').AsString := IData.FirstName;
FQuery.Params.ParamByName('BirthDate').AsDateTime := IData.BirthDate;
end;

Le visiteur sera appliqué à l’objet TPerson après son édition avec TFormPerson :

procedure TFormRepert.aEditExecute(Sender: TObject);
var
aPerson: TPerson;
begin
if ListBox1.ItemIndex < 0 then begin
MessageDlg('Sélectionnez une ligne', mtError, [mbOK], 0);
Exit;
end;
aPerson := TPerson(People.List.Items[ListBox1.ItemIndex]);
TFormPerson.Execute(aPerson);
if ExtractFileExt(CurrentFileName) = '.fdb' then begin
aPerson.AcceptBizObjVisitor(TSQLUpdatePerson.Create(CurrentFileName));
end;
DisplayList;
end;

En fait, au cous de la mise au point de l’application, j’ai été amené à écrire une version un peu plus sophistiquée de cette méthode :

procedure TFormRepert.aEditExecute(Sender: TObject);
var
aPerson: TPerson;
aPersonOld: TPerson;
Visitor: TSQLUpdatePerson;
begin
if ListBox1.ItemIndex < 0 then begin
MessageDlg('Sélectionnez une ligne', mtError, [mbOK], 0);
Exit;
end;
aPerson := TPerson(People.List.Items[ListBox1.ItemIndex]);
aPersonOld := TPerson.Create;
try
aPersonOld.OID := aPerson.OID;
aPersonOld.BirthDate := aPerson.BirthDate;
aPersonOld.FirstName := aPerson.FirstName;
aPersonOld.LastName := aPerson.LastName;
TFormPerson.Execute(aPerson);
if ExtractFileExt(CurrentFileName) = '.fdb' then
if aPerson.Compare(aPersonOld) > 0 then begin
Visitor := TSQLUpdatePerson.Create(CurrentFileName);
try
aPerson.AcceptBizObjVisitor(Visitor);
finally
Visitor.Free;
end;
end;
DisplayList;
finally
aPersonOld.Free;
end;
end;

Remarquez la nouvelle méthode Compare qui permet de comparer deux objets TPerson, afin de n’effectuer la requête SQL que s’il y a eu modification des données. L’implémentation de cette méthode dans TPerson est la suivante:

function TPerson.Compare(aBizObj: TBizObj): Integer;
var
Count: Integer;
begin
Count := 0;
if FBirthDate <> TPerson(aBizObj).BirthDate then
inc(Count);
if FFirstName <> TPerson(aBizObj).FirstName then
inc(Count);
if FLastName <> TPerson(aBizObj).LastName then
inc(Count);
Result := Count;
end;

Le résultat est supérieur à 0 si un champ a été modifié.

Persistance des objets : base de données (suite)

erca57 — Tue, 03 Feb 2009 13:51:19 +0000

Ce 12e billet vous montre les modifications à apporter à l’interface-utilisateur.

Le changement de stratégie annoncé en 2.2 consiste à privilégier l’écriture dans la base de l’objet « personne » à chaque modification, suppression ou création. Cela implique qu’à la fermeture de l’application tous les objets sont d’ores et déjà sauvegardés. Nous allons donc ignorer le sauvegarde en quittant (on close) dans la form TFormRepert quand le fichier courant est une base de données (identifiée ici par son extension .fdb) :

procedure TFormRepert.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ExtractFileExt(CurrentFileName) = '.fdb' then
Exit;
if MessageDlg('Sauvegarder ' + CurrentfileName + ' ?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes
then
aSaveExecute(Sender);
end;

Pour les mêmes raisons nous invalidons les actions de sauvegarde qui n’ont pas de sens ici dans la mesure où la base est à jour au moment où ces commandes sont accessibles dans l’interface. Cette invalidation est exécutée à l’ouverture du fichier (if ExtractFileExt(CurrentFileName) = ‘.fdb’) :

procedure TFormRepert.aOpenExecute(Sender: TObject);
begin
if FileExists(CurrentFileName) then begin
if (MessageDlg('Voulez-vous enregistrer le fichier courant'+#13+#10
+CurrentFileName+' ?', mtWarning, [mbYes, mbNo], 0) = mrYes)
then
aSaveExecute(Sender);
OpenDialog1.InitialDir := ExtractFilePath(CurrentFileName);
end;
if OpenDialog1.Execute then begin
CurrentFileName := OpenDialog1.FileName;
ReadPeopleFromFile(CurrentFileName);
DisplayList;
end;
Self.Caption := ExtractFileName(CurrentFileName);
if ExtractFileExt(CurrentFileName) = '.fdb' then
begin
aSave.Enabled := False;
aSaveAs.Enabled := False;
end
else begin
aSave.Enabled := True;
aSaveAs.Enabled := True;
end;
end;

Profitons-en, maintenant que nous disposons de fichiers de tests, pour modifier la méthode FormCreate en enlevant les instructions de création d’objets de test :

procedure TFormRepert.FormCreate(Sender: TObject);
begin
if not FileExists(CurrentFileName) then
aOpenExecute(Sender)
else begin
ReadPeopleFromFile(CurrentFileName);
Self.Caption := ExtractFileName(CurrentFileName);
DisplayList;
end;
end;

Au lancement de l’application, il vous sera demandé de sélectionner le fichier à ouvrir. Si vous voulez que le dernier fichier utilisé s’ouvre par défaut, il faudra sauvegarder CurrentfileName au moment de quitter l’application et de l’initialiser au début de TFormRepert.FormCreate :

procedure TFormRepert.FormClose(Sender: TObject; var Action: TCloseAction);
var
IniFile: TInifile;
begin
Inifile := TInifile.Create(ChangeFileExt(Application.ExeName,'.ini'));
with IniFile do
try
WriteString('Data','FileName',CurrentfileName);
finally
Free;
end;
if ExtractFileExt(CurrentFileName) = '.fdb' then
Exit;
if MessageDlg('Sauvegarder ' + CurrentfileName + ' ?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes
then
aSaveExecute(Sender);
end;

procedure TFormRepert.FormCreate(Sender: TObject);
var
IniFile: TInifile;
begin
Inifile := TInifile.Create(ChangeFileExt(Application.ExeName,'.ini'));
with IniFile do
try
CurrentFileName := ReadString('Data','FileName','');
finally
Free;
end;
if not FileExists(CurrentFileName) then
aOpenExecute(Sender)
else begin
ReadPeopleFromFile(CurrentFileName);
Self.Caption := ExtractFileName(CurrentFileName);
DisplayList;
end;
end;

ATTENTION !
A ce stade, si l’ajout, la mise à jour et la suppression semblent bien s’effectuer correctement dans l’interface-utilisateur, la base de données .fdb n’est en fait pas mise à jour, les visiteurs TSQLUpdatePerson, TSQLDeletePerson et TSQLInsertPerson n’ayant pas encore été implémentés.

Persistance des objets : utilisation d’une base de données

erca57 — Sun, 01 Feb 2009 13:25:55 +0000

Dans cet onzième épisode nous allons voir comment utiliser SQL pour stocker les objets dans une base de données.

Vous aurez sans doute remarqué dans la livraison précédente que le code des actions de création/modification/suppression est fortement lié à la persistance à l’aide d’une StringList. Nous verrons plus tard qu’il nous faudra retravailler le code afin qu’il fonctionne indifféremment avec une StringList ou une base de données.

Nous y reviendrons après avoir construit les visiteurs pour mettre à jour, insérer et effacer un objet dans une base de données.

2.2 – Persistance SQL (Firebird/Interbase)

Pour la sauvegarde des objets dans une base de données, nous allons changer de stratégie. Ce n’est pas la liste People des personnes qui sera écrite en bloc dans la base, mais chaque objet de la classe TPerson au fur et à mesure de sa création, de sa modification ou de sa suppression. Par contre nous continuerons à lire la liste de personnes en une fois au lancement de l’application, à partir de la table People.
Nous lisons toute la table au début, afin de pouvoir afficher la liste des personnes dans la ListBox. Cette liste peut ne pas afficher tous les champs de la table. Il faudra alors adapter la « décorateur » de l’objet TPeople décrit précédemment (voir en 1.4).

Commençons par le plus simple : la lecture des données.

Nous allons écrire un visiteur de l’objet de la classe TPeople pour charger la liste à partir de la base de données. Pour les premiers tests nous aurons besoin d’une base de données placée dans un fichier PeopleDB.fdb (base de données Firebird). Vous pouvez ausssi utiliser Interbase sans modifier grand chose au code.

Avant toute chose, il nous faut créer la table People dans la base PeopleDB, avec les champs suivants :

OID de type INTEGER,
LastName de type VARCHAR(20),
FirstName de type VARCHAR(20) et
BirthDate de type DATE.

OID sera défini comme clé primaire. Une clé UNIQUE composée de LastName, FirstName et BirhDate peut s’avérer utile pour éviter les doublons.

Notre premier objectif est d’afficher la liste des personnes à partir du fichier PeopleDB.fdb que nous venons de créer. Nous créons à cette fin un visiteur de TPeople appelé TSQLReadPeople.

2.2.1 – Visiteur TSQLReadPeople.

Pour le visiteur de lecture de la table People, je me suis contenté de reproduire la solution élaborée par TechInsite. Je l’aime pour sa simplicité et sa limpidité.

TSQLReadPeople = class(TSQLRead)
protected
procedure Init; override;
procedure MapRowToObject; override;
procedure SetupParams; override;
public
constructor Create(var aFileName: TFileName); overload; override;
destructor Destroy; override;
procedure VisitBizObj(Visited: TBizObj); override;
end;

Nous avons 3 méthodes protégées et 3 méthodes publiques héritées toutes les six de TSQLRead, ancêtre de tous les visiteurs qui lisent une table SQL. La hiérarchie est la suivante:

TSQLReadPeople -> TSQLRead -> TSQLFirebird -> TBizObjVisitor

La connexion à la base s’effectue dans le constructeur Create et la déconnexion dans le destructeur Destroy. Comme ces opérations sont communes à tous les visiteurs d’accès à la base de données, que ce soit en lecture ou en écriture, la connexion et la déconnexion sont implémentées au niveau de l’ancêtre TSQLFirebird.

Cette façon de procéder a un inconvénient majeur : à chaque création/modification/suppression de chaque objet, il y a connexion puis déconnexion, ce qui ralentit fortement l’opération. Nous modifierons cette façon de faire ultérieurement.

2.2.1.1 – Connexion à la base

Comme les constructeurs des descendants de TSQLFirebird font appel au constructeur hérité (inherited Create), c’est le code ci-dessous qui est exécuté à la création de tout visiteur d’accès à une base de données, ici Firebird.

constructor TSQLFirebird.Create(var aFileName: TFileName);
begin
inherited Create(aFileName);
// aFileName must have .fdb extension
if ExtractFileExt(aFileName) <> '.fdb' then
ChangeFileExt(aFileName, '.fdb');
FDatabaseName := aFileName;
//connexion à la base de données
FDB := TIBDatabase.Create(nil);
with FDB do
begin
DatabaseName := FDatabaseName;
Params.Clear;
Params.Add('user_name=USER');
Params.Add('password=password');
LoginPrompt := False;
Connected := True;
end;

FTransaction := TIBTransaction.Create(nil);
FTransaction.DefaultDatabase := FDB;
FDB.DefaultTransaction := FTransaction;

FQuery := TIBQuery.Create(nil);
with FQuery do
begin
Database := FDB;
Transaction := FTransaction;
SQL.Clear;
end;
end;

Le code a été obtenu à partir d’une petite application RAD d’accès à la base de données. Le code généré par Delphi a été copié/collé dans le construteur Create ci-dessus. Y ont été ajoutées les 3 premières instructions:

l’appel du constructeur de l’ancêtre,
la vérification de l’extension du nom du fichier de base de données, et sa rectification éventuelle,
le stockage du nom de la base, avec son chemin d’accès, dans le champ FDatabaseName de

Le destructeur ci-dessous se contente de libérer les objets créés dans le constructeur.

destructor TSQLFirebird.Destroy;
begin
FQuery.Free;
FTransaction.Free;
FDB.Free;
inherited Destroy;
end;

Aucune autre méthode n’est implémentée au niveau de FSQLFirebird, mis à part l’appel inherited à la méthode de l’ancêtre.

Revenons maintenant à notre visiteur TSQLReadPeople.

2.2.1.2 – Lecture de la table

Les 3 méthodes publiques ne sont pas implémentées à ce niveau et font donc appel à l’ancêtre.
Les 3 méthodes protégées sont implémentées dans TSQLReadPeople.

procedure TSQLReadPeople.Init;
begin
FQuery.SQL.Clear;
FQuery.SQL.Add('SELECT * FROM People ORDER BY OID;');
TPeople(FVisited).List.Clear;
end;

La méthode Init se contente d’écrire le code SQL dans FQuery.SQL ; comme il n’y a pas de paramètre dans le code SQL, la méthode SetupParams reste vide. Des paramètres pourraient être utilisés pour remplacer OID dans l’instruction SELECT afin de trier les données selon un autre critère, par exemple le Nom (LastName) et le Prénom (FirstName), voire la date de naissance.

procedure TSQLReadPeople.SetupParams;
begin
// pas de paramètres à ce stade
end;

La méthode MapRowToObject est chargée d’affecter chaque champ d’un enregistrement de la table récupéré par FQuery au champ correspondant de l’objet de type TPerson, pour finalement ajouter l’objet à la liste des personnes de type TPeople :

procedure TSQLReadPeople.MapRowToObject;
var
IData: TPerson;
begin
IData := TPerson.Create;
IData.OID := FQuery.FieldByName('OID').AsInteger;
IData.LastName := FQuery.FieldByName('LastName').AsString;
IData.FirstName := FQuery.FieldByName('FirstName').AsString;
IData.BirthDate := FQuery.FieldByName('BirthDate').AsDateTime;
TPeople(FVisited).Add(IData);
end;

Le code d’itération des enregistrements de la table est implémenté au niveau de TSQLRead, parce qu’il sert à tous les visiteurs destinés à lire les enregistrements d’une table.

2.2.1.3 – Parcours de la table

C’est donc le code ci-dessous qui est exécuté lorsqu’on applique le visiteur TSQLReadPeople à l’objet TPeople.

procedure TSQLRead.VisitBizObj(Visited: TBizObj);
begin
inherited VisitBizObj(Visited);
Init; // Code SQL ; implémenté dans la classe concrète
SetupParams; // Initialise les paramètres du code SQL. Implementé dans la classe concrète
FQuery.Active := True;
while not FQuery.EOF do begin
MapRowToObject;//"Mappe" une requête avec un objet. Implementé dans la classe concrète
FQuery.Next ;
end ;
Finalize;
end;

En premier lieu il est fait appel à la méthode-ancêtre. En remontant la hiérarchie, on remarquera que cela a pour effet de stocker la valeur de Visited dans le champ FVisited qui sera ainsi disponible pour toutes les méthodes de tous les descendants.

Ensuite on exécute Init et SetupParams de TSQLReadPerson, puis on lance la requête en activant FQuery.

Finalement on parcourt les lignes renvoyées par FQuery et on en extrait les champs avec la méthode MapRowToObject, celle implémentée dans TSQLReadPeople.

N’oublions pas d’ajouter le code nécessaire dans la méthode ReadPeopleFromFile de FormRepert :

procedure TFormRepert.ReadPeopleFromFile(FN: TFileName);
var
CsvRead: TCsvTextFileRead;
TxtRead: TFixedTextFileRead;
FileExt: String;
SqlRead: TSQLReadPeople;
begin
FileExt := ExtractFileExt(FN) ;
if FileExt = '.csv' then begin
CsvRead := TCsvTextFileRead.Create(FN);
try
People.AcceptBizObjVisitor(CsvRead);
finally
CsvRead.Free;
end;
end else if FileExt = '.txt' then begin
TxtRead := TFixedTextFileRead.Create(FN);
try
People.AcceptBizObjVisitor(TxtRead);
finally
TxtRead.Free;
end;
end else if FileExt = '.fdb' then begin
SqlRead := TSQLReadPeople.Create(FN);
try
People.AcceptBizObjVisitor(SqlRead);
finally
SqlRead.Free;
end;
end else
ShowMessage('Format de fichier incorrect (extension '+FileExt+')');
end;

Efficace, non ?

Persistance des objets : gestion d’une personne

erca57 — Tue, 06 Jan 2009 10:16:34 +0000

Voilà le dixième article de la série consacrée à la persistance des objets.

Il traite de la gestion d’une personne du répertoire : modification, création, suppression.

2.1.5.3 – Modifier une personne

Pour pouvoir lancer la modification d’une personne, implémentons le code de l’action aEdit de la catégorie Person.

procedure TFormRepert.aEditExecute(Sender: TObject);
begin
if ListBox1.ItemIndex < 0 then begin
MessageDlg('Sélectionnez une ligne', mtError, [mbOK], 0);
Exit;
end;
TFormPerson.Execute(TPerson(People.List.Items[ListBox1.ItemIndex]));
DisplayList;
end;

Tout d’abord le code vérifie qu’une ligne de la ListBox est bien sélectionnée. Si c’est le cas, la méthode de classe TFormPerson.Execute est lancée, avec l’objet à modifier en paramètre. L’objet étant déjà inclus dans la liste People, aucune autre action n’est nécessaire.
Finalement DisplayList procède au rafraichissement de l’affichage de la ListBox.

2.1.5.4 – Créer une personne

La création d’une personne est tout aussi simple.

procedure TFormRepert.aCreateExecute(Sender: TObject);
var
newPerson: TPerson;
begin
newPerson := TPerson.Create;
TFormPerson.Execute(newPerson);
if newPerson = nil then
Exit;
if newPerson.Dirty then
begin
People.Add(newPerson);
DisplayList;
end
else
newPerson.Free;
end;

L’insertion d’une nouvelle personne nécessite la création d’un nouvel objet TPerson vide : newPerson. Son état sera donc bosEmpty. Si nous validons la saisie dans FormPerson avec le bouton Validate qui met Dirty à True, l’état passera de bosEmpty à bosCreate. Si newPerson est détruit, on abandonne l’opération. Sinon, si l’objet est Dirty, on l’ajoute à la liste People. La méthode People.Add est donc sensée mettre l’état de l’objet à bosClean. Il faut modifier la méthode en conséquence:

procedure TPeople.Add(aPerson: TPerson);
begin
aPerson.Dirty := False;
FList.Add(aPerson);
end;

Le fait de mettre Dirty à false a pour conséquence de mettre l’état de l’objet à bosClean.

procedure TBizObj.SetDirty(Value: Boolean);
begin
if Value = True then
case FState of
bosEmpty: FState := bosCreate;
bosDeleted: FState := bosDelete;
bosClean: FState := bosUpdate;
//...
end
else
FState := bosClean;
end;

2.1.5.5 – Supprimer une personne

Le code pour l’effacement d’un objet est des plus dépouillés. Une seule ligne fait tout le travail.

procedure TFormRepert.aDeleteExecute(Sender: TObject);
begin
if ListBox1.ItemIndex < 0 then begin
MessageDlg('Sélectionnez une ligne', mtError, [mbOK], 0);
Exit;
end;
if (MessageDlg('Effacer "'+ListBox1.Items[ListBox1.ItemIndex]+'" ?',
mtConfirmation, [mbYes,mbNo], 0) = mrYes)
then begin
People.List.Delete(ListBox1.ItemIndex);
DisplayList;
end;
end;

Persistance de objets : refactoring de TPerson

erca57 — Mon, 05 Jan 2009 10:19:38 +0000

Dans ce nouvel article de la série sur la persistance des objets, nous allons introduire la notion d’état ObjectState, nécessaire pour gérer la persistance dans une base de données SQL.

2.1.5.2 – Refactoring de TPerson

Dans FormPerson est apparue la propriété Dirty de TPerson. La valeur de cette propriété est liée à l’état ObjectState de l’objet de type TPerson. Les états sont définis au niveau de l’ancêtre TBizObj de TPerson. Un descendant de TBizObj peut en effet être vide de toute donnée quand il vient juste d’être créé. Il sera alors dans l’état bosEmpty (bos pour BizzObj State).
Si nous saisissons et validons des données pour un objet à l’état bosEmpty, il passera à l’état bosCreate qui signifie que cet objet doit être ajouté à la liste ou à la table People. Dès qu’il aura été ajouté, il passera à l’état bosClean, ce qui signifie qu’il est persistant.
Si l’objet est modifié, il passe à l’état bosUpdate. Il devra donc être sauvegardé pour repasser à bosClean.
S’il doit être supprimé, son état sera mis à bosDelete. Dès qu’il aura été supprimé physiquement dans la liste d’objets ou dans la table, il passera pas à l’état bosDeleted. Cela a pour conséquence qu’il ne sera plus affiché. Mais il est toujours possible de le passer à l’état bosCreate si on veut le recréer

Mais revenons à la propriété Dirty. Elle est définie comme suit :
Dirty := ObjectState in [bosCreate, bosUpdate, bosDelete].
Un objet Dirty nécessite donc d’être enregistré ou supprimé. Quand, comme dans TFormPerson.bbtnValidateClick, la propriété Dirty est mise à True, l’état de l’objet est mis à une des valeurs bosCreate, bosUpdate et bosDelete, en fonction de son état courant.

La propriété Deleted permet de savoir rapidement si l’objet doit être affiché ou non :
Deleted := ObjecState in [bosDelete, bosDeleted].

Enfin la propriété OID servira d’identifiant pour l’enregistrement éventuel de l’objet dans une table SQL.

TBizObjID = Int64;

TObjectState = //le préfixe bos signifie BizObj State
(bosEmpty, //le BizObject vient d'être créé et est encore vide
bosCreate, //le bo est à insérer dans le fichier ou la base de données
bosUpdate, //le bo est à mettre à jour dans le fichier ou la bdd
bosDelete, //le bo est à supprimer du fichier ou de la bdd
bosDeleted, //le bo a été supprimé dans le fichier ou la bdd
bosClean); //l'état du bo correspond à son état dans le fichier ou la bdd

TBizObj = class(TObject)
private
FOID: TBizObjID;
FState: TObjectState;
function GetDeleted: Boolean;
function GetDirty: Boolean;
function GetOID: TBizObjID;
procedure SetDirty(Value: Boolean);
public
procedure AcceptBizObjVisitor(Visitor: TBizObjVisitor); virtual;
property Deleted: Boolean read GetDeleted;
property Dirty: Boolean read GetDirty write SetDirty;
property OID: TBizObjID read GetOID write FOID;
property State: TObjectState read FState write FState;
end;

Vous trouverez ci-dessous l’implementation des nouvelles propriétés:

function TBizObj.GetDeleted: Boolean;
begin
Result := (FState in [bosDelete, bosDeleted]);
end;

function TBizObj.GetDirty: Boolean;
begin
Result := (FState in [bosCreate, bosUpdate, bosDelete]);
end;

function TBizObj.GetOID: TBizObjID;
var
DT: TDateTime;
begin
if FOID = 0 then begin
//générer un nouvel identifiant basé sur l'instant courant
DT := Now - StrToDate('31/08/08');
Result := ( ( trunc(DT) * 1000000 ) + ( trunc(frac(DT) * 1000000) ) );
end;
Result := FOID;
end;

procedure TBizObj.SetDirty(Value: Boolean);
begin
if Value = True then
case FState of
bosEmpty: FState := bosCreate;
bosDeleted: FState := bosDelete;
bosClean: FState := bosUpdate;
//...
end
else
FState := bosClean;
end;

Persistance des objets : gestion des personnes

erca57 — Sun, 21 Dec 2008 17:20:56 +0000

Voici enfin la suite de ma série d’articles sur un exemple de persistance d’objets.

2.1.5 – Gestion des personnes

Nous allons maintenant implémenter les trois actions non activées de la catégorie Person : aEdit, aCreate et aDelete.
Pour éditer les propriétés ou attributs d’un objet Person, nous allons créer un formulaire de saisie FormPerson dans l’unité uFPerson.

2.1.5.1 – Formulaire de saisie

Le formulaire FormPerson est présenté dans la figure ci-dessous en mode de conception :

Il contient:
– trois TLabel : LabelLastName affichant « Nom : », LabelFirstName affichant « Prénom : » et LabelBirthDate affichant « Date de naissance : »
– deux TEdit : EditLastName et EditFirstName;
– un TDateTimePicker : DateTimePickerBirth;
– un TBitButton de type OKButton : bbtnValidate avec le texte « Valider ».

Les développeurs de tiOPF utilisent une méthode de classe Execute pour afficher le formulaire de saisie à la façon des composants Dialogues de Delphi. Je n’ai pu m’empêcher de les imiter. Tout le code concernant la mise à jour des données est ainsi encapsulé dans TFormPerson.
Vous remarquerez la propriété Data qui permet de synchroniser l’objet de classe TPerson passé en paramètre dans Create et les champs EditFirstName, EditLastName et DateTimePickerBirth.

TFormPerson = class(TForm)
bbtnValidate: TBitBtn;
DateTimePickerBirth: TDateTimePicker;
EditFirstName: TEdit;
EditLastName: TEdit;
LabelBirthDay: TLabel;
LabelFirstName: TLabel;
LabelLastName: TLabel;
procedure bbtnValidateClick(Sender: TObject);
private
FData: TPerson;
function GetData: TPerson;
procedure SetData(Value: TPerson);
public
class function Execute(aPerson: TPerson): Boolean;
property Data: TPerson read GetData write SetData;
end;

L’implémentation est des plus dépouillées:

procedure TFormPerson.bbtnValidateClick(Sender: TObject);
begin
Data.Dirty:= True;
ModalResult := mrOK;
end;

La nouveauté dans le code ci-dessus est la propriété Dirty de la classe TPerson. Mettre Dirty à True sert à informer que l’objet courant n’a pas été ajouté à la liste People ou enregistré dans la table People d’une base de données.

class function TFormPerson.Execute(aPerson: TPerson): Boolean;
begin
FormPerson := TFormPerson.Create(nil);
with FormPerson do
try
Data := aPerson;
ShowModal;
finally
Free;
end;
end;

La méthode de classe ne présente pas de difficulté particulière. Notez que l’objet à éditer dans le formulaire est passé en paramètre. La puissance de cette façon de faire réside dans les méthodes GetData et SetData.

function TFormPerson.GetData: TPerson;
begin
FData.FirstName := EditFirstName.Text;
FData.LastName := EditLastName.Text;
FData.BirthDate := DateTimePickerBirth.Date;
Result := FData;
end;

procedure TFormPerson.SetData(Value: TPerson);
begin
FData := Value;
EditFirstName.Text := FData.FirstName;
EditLastName.Text := FData.LastName;
DateTimePickerBirth.Date := FData.BirthDate;
end;

GetData et SetData permettent de synchroniser les champs du formulaire avec les champs de l’objet Data qui n’est autre que l’objet aPerson passé en paramètre de la méthode de classe Execute.

Persistance des objets : GUI de l’exemple

erca57 — Tue, 25 Nov 2008 12:09:31 +0000

2.1.4 – Nouvelle interface-utilisateur

Après avoir montré comment sauvegarder et lire des objets dans des fichiers-textes, je vous propose de compléter l’interface-utilisateur.

La figure 2 ci-dessus montre FormRepert en mode conception.

Remarquez les boutons et les composants qui ont été ajoutés, ainsi que les images affectées aux boutons et qui sont contenues dans ImageList1.

ImageList1 est affectée aux propriétés Images de ToolBar1, ActionList1 et MainMenu1.

Les actions contenues dans ActionList1 sont aNew, aOpen, aSave, aSaveAs et aExit dans la catégorie File, et aCreate, aModify et aDelete dans la catégorie Person.

A ce stade ne sont implémentées que les méthodes correspondant aux actions du groupe File:

procedure TFormRepert.aExitExecute(Sender: TObject);
begin
Close;
end;

procedure TFormRepert.aNewExecute(Sender: TObject);
begin
if (MessageDlg('Voulez-vous enregistrer le fichier courant ?',
mtWarning, [mbYes, mbNo], 0) = mrYes)
then
aSaveExecute(Sender);
People.Clear;
ListBox1.Items := PeopleList.Strings;
end;

procedure TFormRepert.aOpenExecute(Sender: TObject);
begin
if OpenDialog1.Execute then begin
CurrentFileName := OpenDialog1.FileName;
ReadPeopleFromFile(CurrentFileName);
ListBox1.Items := PeopleList.Strings;
end;
end;

procedure TFormRepert.aSaveAsExecute(Sender: TObject);
begin
//enregistrer dans un fichier différent
SaveDialog1.InitialDir := ExtractFilePath(CurrentFileName);
SaveDialog1.DefaultExt := ExtractFileExt(CurrentFileName);
if SaveDialog1.Execute then begin
CurrentFileName := SaveDialog1.FileName;
SavePeopleToFile(CurrentfileName);
end;
end;

procedure TFormRepert.aSaveExecute(Sender: TObject);
begin
//enregistrement dans le fichier actif, sinon enregistrer sous
if not FileExists(CurrentFileName) then
aSaveAsExecute(Sender)
else begin
SavePeopleToFile(CurrentFileName);
MessageDlg('Le fichier'+#13+#10+CurrentFileName+#13+#10
+'a été correctement enregistré', mtInformation, [mbOK], 0);
end;
end;