Pascal : apprendre l'encapsulation dans un objet gérant l'accès à une base de données SQLite

Un billet de tourlourou

Introduction :

La récupération des résultats des requêtes par l'API SQLite et le wrapper développé précédemment se révèle vite fastidieuse, nécessitant à chaque fois l'implémentation de fonctions adaptées au besoin. L'idée est née de standardiser et automatiser cette phase à destination d'objets simples et familiers (champ, TStrings, TStringGrid). Pour cela, l'encapsulation dans un objet gérant l'accès à une base de données permet de se décharger des soucis de gestion, de manipulation et d'interaction avec la base et les données.

Définition du problème :

L'objectif est clairement dessiné : se faciliter la vie ! Pour ceci, un objet (encore !) est choisi pour assurer l'interface entre l'API de SQLite et des types de données bien connus de l'utilisateur lambda que je suis, qui ne serait pas familier des composants spécifiques ou orientés BDD (DataSet, DataSource, Connection, Query et que sais-je ?) et de leurs nécessaires relations.
Restant au niveau d'un utilisateur de fonctions basiques, il n'est question que d'exécuter des requêtes simples, de récupérer des données par lecture de la base, sans mise à jour bidirectionnelle, celle-ci passant par des requêtes SQL.

Il suffit d'un objet :
1) assurant la communication avec la librairie SQLite, basé sur le wrapper dédié, masquant les appels aux fonctions de l'API et handles nécessaires ;
2) exposant des fonctions pour ouvrir et fermer une base (c'est-à-dire un fichier) ;
3) permettant d'exécuter une requête simple n'attendant pas de données en retour (INSERT, par exemple) ;
4) proposant des méthodes pour exécuter une requête et en récupérer les données selon des modalités variées.

Le mode particulier de gestion des BLOBs (Binary Large Objects) dans SQLite conduit à les gérer par des méthodes dédiées, tandis que toutes les autres données sont récupérables en mode texte dans le cadre de notre exploitation minimale de l'API, au moyen de la fonction exec et d'une fonction de rappel. Le but de cet objet va justement être de rendre transparente cette gymnastique et les fonctions CallBack requises (tout en laissant à l'utilisateur la possibilité de gérer les événements par ses propres fonctions).

Selon la dimension du résultat de la requête, il pourra être récupéré dans :
1) une chaîne (String) : SELECT date(''now'') ;
2) un champ (TlyField) pour une donnée qu'il convertit à la demande (cf. billet précédent) : SELECT max(salaire) FROM employes ;
3) une liste de chaîne (TStrings) correspondant à la première colonne de résultat : SELECT nom FROM employes WHERE salaire > 2000 ;
4) une liste de chaîne (TStrings) correspondant à la première ligne de résultat : SELECT * FROM employes WHERE id = 5 ;
5) une grille de chaînes (TStringGrid) : SELECT * FROM employes.

On ajoutera quelques gadgets ou facilités (gestion des messages d'erreur, gestionnaire de progression, journalisation, etc.).

Idéalement, l'utilisateur n'a à connaître de l'objet que ses propriétés et méthodes qui lui sont utiles, le reste étant encapsulé, avec une visibilité contrôlée, comme un moteur sous le capot ! Mais l'interface publique dévoile certaines mécaniques sous-jacentes...

Interface publique :

Elle déclare tout d'abord les constantes (dont codes d'erreur propres) et types nécessaires :

unit lySqlite3DB;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, Controls, Grids,
lySQLite3Intf, lySQLite3Param;

const
// chaîne à passer à la place d'une requête simple pour exécuter une requête paramétrée
UseParamSQL = '';
// pour une écriture de BLOB immédiatement après insertion
LAST_INSERT_ROWID = -1;

// Codes d'erreur propres à cette unité
LYSQLITEDB_SQLITEERROR = -1; // en interne, pour consulter l'erreur positionnée par SQLite
LYSQLITEDB_DBOPENERROR = -2; // erreur d'ouverture inconnue (SQLITE_OK retourné, mais pas de handle sur la DB)
LYSQLITEDB_CALLBACKERR = -3; // erreur lors de l'exécution d'une fonction de rappel (CallBack) de l'utilisateur
LYSQLITEDB_EMPTYRESULT = -4; // requête sans erreur ni résultat (pas de ligne retournée ni de CallBack déclenchée)
LYSQLITEDB_NOTASSIGNED = -5; // l'objet attendu en paramètre est reçu nil
LYSQLITEDB_LACKSONECOL = -6; // il manque une colonne => pas de résultat
LYSQLITEDB_TOOMANYCOLS = -7; // le résultat a plus de colonnes qu'attendues => tronqué à la première colonne
LYSQLITEDB_TOOMANYROWS = -8; // le résultat a plus d'une ligne => tronqué à la première ligne
LYSQLITEDB_SIZEBLOBERR = -9; // le champ BLOB est trop petit pour y écrire le Stream

type
// événements utilisateur déclenchables en CallBack
// au début de chaque nouvelle ligne de résultat d'une requête
TOnNewRow = procedure(aSender: TObject; aColCount: integer) of object;
// à chaque nouvelle colonne d'une ligne de résultat d'une requête
TOnNewCol = procedure(aSender: TObject; aColumn: string; aValue: string) of object;
// à la fin de chaque ligne de résultat d'une requête (donc après sa dernière colonne)
TOnEndRow = procedure(aSender: TObject) of object;
// log externe (en activant la propriété AutoLog, il est assuré en interne)
TOnLog = procedure(aSender: TObject; aText: string) of object;
// tous les FProgressInterval d'une requête longue (renvoyer autre chose que SQLITE_OK stoppe la requête)
TOnProgress = function(aSender: TObject): integer of object;

Elle expose ensuite les propriétés et méthodes de l'objet proposé :

// classe singleton qui encapsule une BDD SQLite3 (version 3.7.13)
TlySQLiteDB = class
//... ne soulevons pas le capot pour l'instant*!
public
constructor Create; overload; // une seule instance : singleton
destructor Destroy; override;
// gestion fichier BDD
function Open(aDBName: TFileName): Boolean; overload; virtual;
function Close: Boolean; overload; virtual;
//**************************************************************************
// les fonctions suivantes exécutent les requêtes. En passant UseParamSQL plutôt
// qu'une chaîne aSQL, la requête paramétrée TlySQLiteDB.ParamSQL sera utilisée.
//**************************************************************************
// exécute la requête sans déclencher les CallBacks utilisateur
// et retourne exclusivement les dimensions du résultat (nb de colonnes et de lignes)
function Count(var aRowCount: integer; var aColCount: integer; aSQL: string = UseParamSQL): Boolean;
//**************************************************************************
// les fonctions suivantes exécutent la requête et déclenchent les CallBacks utilisateur
// exécution simple de la ou des requêtes
function Execute(aSQL: string = UseParamSQL): Boolean;
function Execute(aRequests: TStrings): Boolean; overload;
// exécute la requête et renvoie la valeur dans une chaîne
function ToString(var aString: string; aSQL: string = UseParamSQL): Boolean; overload;
// exécute la requête et renvoie la première colonne du résultat
function FirstColToStrings(aStrings: TStrings; aSQL: string = UseParamSQL): Boolean;
// exécute la requête et renvoie la valeur dans un objet de type champ pour le manipuler commodément
function ToField(var aField: TlyField; aSQL: string = UseParamSQL): Boolean;
// exécute la requête et renvoie la première ligne du résultat (au format ini ColumnName=Value sur option)
function FirstLineToStrings(aStrings: TStrings; aSQL: string = UseParamSQL; aIniStyle: Boolean = False): Boolean;
// exécute la requête et renvoie les 2 premières colonnes du résultat au format ini Column1=Column2
function TwoColsToIniStrings(aStrings: TStrings; aSQL: string = UseParamSQL): Boolean;
// exécute la requête et renvoie le résultat dans la grille
function ToStringGrid(aGrid: TStringGrid; aSQL: string = UseParamSQL): Boolean;
//**************************************************************************
// accès aux BLOBs grâce aux streams. SQLite nécessite le nom de la base :
// 'main', 'temp', ou alias d'une seconde base ouverte par la requête ATTACH
// copie une portion du stream dans un BLOB
function StreamToBlob(aStream: TStream; aSize, aOffset: integer; aDBSymbolicName, aTable, aColumn: string; aRow: integer = LAST_INSERT_ROWID): integer;
// copie le BLOB à la fin du stream
function BlobToStream(aDBSymbolicName, aTable, aColumn: string; aRow: integer; aStream: TStream): integer;
// informations
property LastInsertRowId: integer read getRowId; // dernier indice d'insertion ; <1 si erreur
property LastErrorCode: integer read FLastErrorCode; // code interne de SQLite ou propre à cette unité
property LastErrorMsg: string read FLastErrorMsg; // à consulter si une requête (une fonction) renvoie FALSE
property Version: string read getVersion; // n° version librairie
property Charset: string read getCharset; // encodage de la base
property FileName: TFileName read DBName; // nom du fichier
property LogFile: TFileName read LogFileName; // nom du fichier de log
// requête paramétrée
property ParamSQL: TlyParamSQL read FParamSQL;
// CallBacks
property OnNewRow: TOnNewRow read FUserNewRow write FUserNewRow;
property OnNewCol: TOnNewCol read FUserNewCol write FUserNewCol;
property OnEndRow: TOnEndRow read FUserEndRow write FUserEndRow;
// journalisation
property AutoLog: Boolean read FAutoLog write setAutoLog; // déclenche ensuite le OnLog de l'utilisateur
property OnLog: TOnLog read FUserLog write setUserLog;
property LogRequests: Boolean read FLogRequests write FLogRequests;
// progression requête : si intervalle nul, événement jamais appelé
property ProgressInterval: integer read FProgressInterval write setInterval;
property OnProgress: TOnProgress read FOnProgress write setOnProgress; // n'attribuer que si BD déjà ouverte !!!
end;

On y trouve plusieurs propriétés aux noms en principe explicites, et les méthodes indispensables. Tout d'abord un constructeur et un destructeur, surchargés pour les besoins propres de l'objet. Puis les fonctions permettant d'ouvrir ou fermer une base ainsi que d'exécuter des requêtes.

:alerte: Afin d'éviter de créer des situations où plusieurs instances de l'objet pourraient vouloir chacune modifier la même base, j'ai fait le choix de n'en autoriser qu'une, en recourant au pattern singleton.
Il est aisé de modifier le constructeur pour autoriser la création d'instances multiples, en cas de besoin.

Implémentation de l'objet :

Cycle de vie de l'objet :

Abordons d'abord sa création/libération, sans autre particularité que la gestion du singleton, grâce à une variable dédiée :

implementation

var
UneSeuleInstance: TlySQLiteDB = nil; // singleton

constructor TlySQLiteDB.Create;
begin
if Assigned(UneSeuleInstance)
then raise Exception.Create('Une seule instance de TlySQLiteDB autorisée ; désolé.')
else inherited Create;
UneSeuleInstance:=self; // car singleton
FRow:=0;
FCol:=0;
FFireUserCallBacks:=True;
FGrid:=nil;
FStrings:=nil;
FLastErrorCode:=SQLITE_OK;
FLastErrorMsg:='';
DB:=nil;
DBName:='';
FInternalNewRow:=nil;
FInternalNewCol:=nil;
FInternalEndRow:=nil;
FUserNewRow:=nil;
FUserNewCol:=nil;
FUserEndRow:=nil;
FUserLog:=nil;
FOnLog:=nil;
FAutoLog:=False;
FLogRequests:=False;
ProgressInterval:=0;
FParamSQL:=TlyParamSQL.Create;
end;

destructor TlySQLiteDB.Destroy;
begin
if not Close
then raise Exception.Create('Libération de TlySQLiteDB interdite : la base ne peut être fermée');
FParamSQL.Free;
UneSeuleInstance:=nil;
inherited Destroy;
end;

initialization
// RAS

finalization
if Assigned(UneSeuleInstance) then FreeAndNil(UneSeuleInstance);

end.

Le constructeur est fort simple, chargé d'initialisations triviales, de la création du seul champ objet interne (gérant les requêtes paramétriques, cf. article précédent), et implémentant le patron de conception singleton, qui n'autorise la création que d'une seule instance de l'objet. Parallèlement, le destructeur est désarmant de simplicité mais interdit de libérer l'objet si la base ne peut être fermée car des ressources n'ont pas été libérées dans la librairie.

:fleche: On aurait tout aussi bien pu initialiser la variable UneSeuleInstance dans la section initialization que lors de sa déclaration.

Gestion des erreurs et journalisation :

Le succès d'une méthode est signalé par son résultat positionné à True. Les erreurs font l'objet d'une description par code et message (en anglais), à consulter en cas d'échec (propriétés LastErrorCode et LastErrorMsg). Certaines erreurs sont signalées par l'API SQLite et répercutées par les méthodes concernés, tandis que d'autres sont propres à cette unité. La gestion des messages d'erreur fait donc intervenir une fonction intermédiaire, très simple, pour centraliser leur traitement :

function TlySQLiteDB.setLastError(aCode: integer): integer;
begin
Result:=aCode;
if aCode >= LYSQLITEDB_SQLITEERROR
then Exit // ne rien faire de plus : pas d'erreur ou code et message déjà renseignés (par Execute, pe)
else FLastErrorCode:=aCode;
case aCode of
LYSQLITEDB_DBOPENERROR : FLastErrorMsg:='SQLite_OK but no valid DB Handle returned.';
LYSQLITEDB_CALLBACKERR : FLastErrorMsg:='Request OK but User CallBack Error encountered : '+ FCallErrorMsg;
LYSQLITEDB_EMPTYRESULT : FLastErrorMsg:='SQLite_OK but no row returned.';
LYSQLITEDB_NOTASSIGNED : FLastErrorMsg:='Assigned Object parameter wanted.';
LYSQLITEDB_LACKSONECOL : FLastErrorMsg:='Result lacks one column.';
LYSQLITEDB_TOOMANYCOLS : FLastErrorMsg:='Multi-Columns Result : first(s) returned.';
LYSQLITEDB_TOOMANYROWS : FLastErrorMsg:='Multi-Rows Result : first returned.';
LYSQLITEDB_SIZEBLOBERR : FlastErrorMsg:='BLOB too short for Stream.';
else FLastErrorMsg:='Unknown Error Encountered in TlySQLiteDB.';
end;
end;

La journalisation peut être assurée de multiples façons :
1) par SQLite, qui dispose de fonctionnalités intégrées activables par le SQL 'PRAGMA journal_mode' ;
2) en interne, par l'objet ;
3) par l'utilisateur, grâce à une fonction de rappel qui sera appelée lors des événements internes.

Ceci fait appel à un mécanisme commun, une fonction DoLog, qui en appelle une autre : soit interne (LogIt), soit externe, fournie par l'utilisateur.

:fleche: L'utilisateur devant rester libre de demander la journalisation automatique et de recevoir les événements en parallèle, LogIt devra aussi déclencher l'éventuelle CallBack utilisateur.

Les propriétés visibles pour l'utilisateur sont :
1) AutoLog : True, elle charge l'objet de la journalisation (DoLog devra appeler LogIt) ;
2) UserLog : adresse de la fonction de rappel de Log de l'utilisateur ;
3) LogRequests : True pour journaliser les requêtes en plus des ouvertures, des fermetures et des erreurs ;
4) LogFile : nom du fichier de journalisation.

procedure TlySQLiteDB.LogIt(aSender: TObject; aText: string);
var
F: TextFile;
Allonger: Boolean;
begin
aText:= FormatDateTime('yyyy/mm/dd hh:mm:ss:zzz" : "', Now)+aText;
{$IFDEF DEBUG}
ShowMessage(aText);
Exit;
{$ENDIF}
Allonger:=FileExists(LogFileName);
AssignFile(F, LogFileName);
if Allonger
then Append(F)
else Rewrite(F);
WriteLn(F, aText);
Flush(F);
CloseFile(F);
if Assigned(FUserLog) then FUserLog(aSender, aText);
end;

procedure TlySQLiteDB.setAutoLog(aValue: Boolean);
begin
FAutoLog:=aValue;
if FAutoLog
then FOnLog:=@LogIt
else FOnLog:=FUserLog;
end;

procedure TlySQLiteDB.setUserLog(aValue: TOnLog);
begin
FUserLog:=aValue;
if FAutoLog
then FOnLog:=@LogIt
else FOnLog:=FUserLog;
end;

procedure TlySQLiteDB.DoLog(aText: string);
begin
if Assigned(FOnLog) then FOnLog(self, aText);
end;

:alerte: La journalisation ne tient pas compte de la taille du fichier et l'allonge indéfiniment : on pourrait la vérifier et proposer d'en supprimer le début une fois une limite atteinte.

Connexion à une base :

Une fois les fonctions accessoires définies, les fonctions se chargeant de l'ouverture et de la fermeture d'une base ont alors les moyens de remplir leur office. Ce sont des encapsulations des fonctions open et close du wrapper de l'API SQLite définie dans le premier billet. Leur intérêt est de masquer les variables et les appels nécessaires, en assurant la gestion des erreurs éventuelles.

:fleche: La fonction Open n'autorise qu'un fichier ouvert à la fois. Pour faciliter une utilisation simple et basique, ma philosophie était de décharger l'utilisateur de la tâche de désigner sur quelle base il veut travailler en n'en gérant qu'une !
Cependant, pour répondre au besoin de travailler sur plusieurs bases :
1) SQLite permet d'en joindre de nouvelles à une même connexion (10 par défaut, mais jusqu'à 62 !) grâce à la commande SQL ATTACH qui ouvre le fichier correspondant sous un alias : ATTACH DATABASE "c:\userfiles\test2.bdd" AS base2 ;
2) on peut aussi transformer aisément l'objet en multi-instances au lieu de singleton pour avoir des objets séparés traitant des bases distinctes.

On a ici le premier exemple de gestion des codes d'erreur SQLite ou internes, Open positionnant ceux de l'API et laissant à SetLastError le soin de positionner les siens. L'opération est journalisée. On note que le message d'erreur SQLite éventuel est récupéré, copié et sa ressource libérée.

function TlySQLiteDB.Open(aDBName: TFileName): Boolean;
var
RetCode, ErrCode: integer;
pDB: PSQLiteDB;
Error: PChar;
begin
Result:=False;
// si même base, on ferme quand même pour rouvrir : tant pis...
// mais rouvrira sans bases attachées éventuelles
if Assigned(DB) then Close;
pDB:=nil;
RetCode:=sqlite3_open(PChar(aDBName), pDB);
if RetCode=SQLITE_OK
then begin
if Assigned(pDB)
then begin
DB:=pDB; // on passe la connexion à la BDD
sqlite3_extended_result_codes(DB, True); // autorise les codes d'erreur étendus (sur plus d'1 octet)
end
else RetCode:=LYSQLITEDB_DBOPENERROR;
end
else begin
// relais du message d'erreur de SQLite
Error:=sqlite3_errmsg;
FLastErrorMsg:=StrPas(Error);
// libération des ressources
sqlite3_free(Error);
sqlite3_close(pDB); // pas grave si pDB vaut nil (NOP)
end;
// MAJ du code d'erreur (voire du message d'erreur, si généré par cette unité)
ErrCode:=setLastError(RetCode);
if ErrCode=SQLITE_OK
then begin
DBName:=aDBName;
LogFileName:=ChangeFileExt(DBName, '.log');
DoLog('Database : '+DBName+' correctly opened');
Result:=True;
end
else DoLog('Can''t open Database : '+aDBName+' ; error '+IntToStr(FLastErrorCode)+' : '+FLastErrorMsg);
end;

Idem pour Close. En cas de transaction en cours, Close l'annulera. Close échouera en cas de ressources non refermées : requêtes pré-compilées ou BLOBs.

function TlySQLiteDB.Close: Boolean;
var
RetCode: integer;
Error: PChar;
begin
Result:=False;
RetCode:=sqlite3_close(DB);
if RetCode=SQLITE_OK
then begin
if Assigned(DB)
then begin
DB:=nil;
DoLog('Database : '+DBName+' closed');
DBName:='';
end;
Result:=True;
end
else begin
FLastErrorCode:=RetCode;
// relais du message d'erreur de SQLite
Error:=sqlite3_errmsg;
FLastErrorMsg:=StrPas(Error);
// libération des ressources
sqlite3_free(Error);
DoLog('Can''t close database : '+DBName+' : '+FLastErrorMsg);
end;
end;

Exécution d'une requête :

La fonction exec de SQLite renvoie les résultats de la requête grâce à une fonction de rappel fournie par le code appelant, cf. exemples d'utilisation du wrapper dans le premier billert. La CallBack lyCallBack au format de l'API SQLite est déclenchée pour chaque ligne de résultat et retourne nombre de colonnes, noms des champs et valeurs au format texte.
Pour conférer plus de souplesse à la récupération des résultats dans les fonctions spécifiques développées ensuite et afin d'alléger le code en évitant des redondances, j'ai préféré créer plusieurs fonctions de rappel en leur attribuant à chacune une tâche élémentaire et des paramètres de types plus simples. Elles correspondent aux événements :
1) nouvelle ligne, avec passage du nombre de colonnes ;
2) nouvelle colonne, avec passage du nom de la colonne et de la valeur du champ dans deux chaînes ;
3) fin de ligne.
A chaque événement, la fonction déclenchera d'abord l'éventuelle fonction de rappel interne, puis la CallBack utilisateur (sauf désactivation imposée par le champ FfireUserCallBacks, utile pour la fonction Count).
J'ai choisi de gérer l'appel aux CallBacks utilisateur dans un bloc try except pour permettre le traitement jusqu'au bout, en signalant à l'utilisateur l'exception par un code erreur privé final.
Le paramètre aSender nous permet de récupérer la référence à l'objet TlySQLiteDB, car nous prendrons soin de le fournir lors de chaque appel à la fonction exec !

// interface entre récupération des résultats au format SQLite exec et modes proposés à l'utilisateur
// les événements internes à l'objet effectuent les traitements et sont déclenchés en priorité
// les CallBacks utilisateur éventuelles sont déclenchées dans un second temps seulement
function lyCallBack(aSender: TObject; aColCount: integer; aValues: Pointer; aNames: Pointer): integer; cdecl;
var
DB: TlySQLiteDB;
PValues: ^PChar;
PNames: ^PChar;
i: Integer;
begin
DB:=TlySQLiteDB(aSender);
PValues:=aValues;
PNames:=aNames;
// déclenche l'événement nouvelle ligne
if Assigned(DB.FInternalNewRow) then
DB.FInternalNewRow(aSender, aColCount);
if DB.FFireUserCallBacks and Assigned(DB.FUserNewRow) then
try
DB.FUserNewRow(aSender, aColCount);
except
on E: Exception
do begin
DB.FCallErrorCode:=LYSQLITEDB_CALLBACKERR;
DB.FCallErrorMsg:=E.Message;
end;
end;
// envoie la ligne colonne par colonne
for i:=0 to aColCount-1
do begin
if Assigned(DB.FInternalNewCol) then
DB.FInternalNewCol(aSender, string(PNames^), string(PValues^));
if DB.FFireUserCallBacks and Assigned(DB.OnNewCol) then
try
DB.OnNewCol(aSender, string(PNames^), string(PValues^));
except
on E: Exception
do begin
DB.FCallErrorCode:=LYSQLITEDB_CALLBACKERR;
DB.FCallErrorMsg:=E.Message;
end;
end;
Inc(PValues);
Inc(PNames);
end;
// signale la fin de la ligne
if Assigned(DB.FInternalEndRow) then
DB.FInternalEndRow(aSender);
if DB.FFireUserCallBacks and Assigned(DB.OnEndRow) then
try
DB.OnEndRow(aSender);
except
on E: Exception
do begin
DB.FCallErrorCode:=LYSQLITEDB_CALLBACKERR;
DB.FCallErrorMsg:=E.Message;
end;
end;
// cad prêt pour ligne suivante
Result:=SQLITE_OK;
end;

Une fois cette fonction CallBack définie, on a tous les outils pour exécuter une requête. Pour ce faire, on encapsule l'appel à exec dans la fonction Execute. Elle utilise le SQL fourni ou la requête paramétrique interne, et traite la valeur de retour et le log éventuel. Cette fonction servira pour des requêtes utilisateur sans résultat (CREATE, INSERT, UPDATE, PRAGMA...) ou dont il gérera la récupération.
Même si SQLite gère les requêtes multiples séparées dans une même chaîne par des points-virgules, nous fournirons par commodité une version surchargée de Execute qui accepte une liste de chaînes correspondant chacune à une requête.

function TlySQLiteDB.Execute(aSQL: string{ = UseParamSQL}): Boolean;
var
ErrCode: integer;
Requete: String;
Error: PChar;
begin
Result:=False;
Error:=nil;
FCallErrorCode:=SQLITE_OK;
if aSQL>UseParamSQL
then Requete:=aSQL
else Requete:=FParamSQL.Request;
ErrCode:=sqlite3_exec(DB, PChar(Requete), @lyCallBack, self, Error);
if ErrCode=SQLITE_OK
then begin
if FLogRequests
then DoLog('Request : '+Requete);
if FCallErrorCode=SQLITE_OK
then Result:=True
else setLastError(FCallErrorCode);
end
else begin
FLastErrorCode:=ErrCode;
FLastErrorMsg:=StrPas(Error);
sqlite3_free(Error);
DoLog('Error : '+FLastErrorMsg+' for request : '+Requete);
end;
end;

function TlySQLiteDB.Execute(aRequests: TStrings): Boolean;
var
j: integer;
NextOne, Res: Boolean;
begin
Result:=False;
if Assigned(aRequests)
then begin
j:=0;
NextOne:=True;
while NextOne
do begin
Res:=Execute(aRequests);
if Res
then begin
Inc(j);
if j < aRequests.Count
then NextOne:=True
else begin
NextOne:=False;
Result:=True;
end;
end
else Break;
end;
end
else setLastError(LYSQLITEDB_NOTASSIGNED);
end;


Requête Count :

Il est parfois utile de connaître les dimensions du résultat d'une requête, d'où la fonction Count. Elle est chargée de simplement en retourner le nombre de lignes et de colonnes. Pour ce faire, elle appelle la fonction Execute après avoir désactivé les CallBacks utilisateur et fixé la seule CallBack interne de type TOnNewRow nécessaire pour assurer le compte :

procedure TlySQLiteDB.CountNewRow(aSender: TObject; aColCount: integer);
begin
if FRow=0 then FCol:=aColCount;
Inc(FRow); // ajout de la ligne
end;

// exécute la requête sans déclencher les CallBacks utilisateur
// et retourne exclusivement les dimensions du résultat (nb de colonnes et de lignes)
function TlySQLiteDB.Count(var aRowCount: integer; var aColCount: integer; aSQL: string{ = UseParamSQL}): Boolean;
begin
FRow:=0;
FCol:=0;
FFireUserCallBacks:=False;
FInternalNewRow:=@CountNewRow;
FInternalNewCol:=nil;
FInternalEndRow:=nil;
Result:=Execute(aSQL);
FInternalNewRow:=nil;
aRowCount:=FRow;
aColCount:=FCol;
end;

Requêtes à résultat unique :

Certaines requêtes retournent un résultat unique (une seule ligne et une seule colonne) : SELECT date("now") ou PRAGMA encoding ou SELECT nom FROM employes WHERE id = 5.
Les fonctions ToString et ToField simplifient la récupération de leur résultat. La première exploite d'ailleurs la seconde, même s'il aurait été aisé de la coder indépendamment en calquant son fonctionnement dessus, au prix de la multiplication des CallBacks.
Les fonctions de rappel utiles sont d'abord définies. Elles servent à affecter la valeur du résultat, mais aussi à vérifier les dimensions du résultat pour signaler au besoin le dépassement par des codes internes :

procedure TlySQLiteDB.FieldNewRow(aSender: TObject; aColCount: integer);
begin
FCol:=0;
Inc(FRow);
end;

procedure TlySQLiteDB.FieldNewCol(aSender: TObject; aColumn: string; aValue: string);
begin
FreeAndNil(FField);
FField:=TlyField.Create(aColumn);
FField.AsText:=aValue;
Inc(FCol);
end;

procedure TlySQLiteDB.CommonEndRow(aSender: TObject);
begin
FEmptyResult:=False;
end;

// exécute la requête et renvoie la valeur dans un objet de type champ pour le manipuler commodément
function TlySQLiteDB.ToField(var aField: TlyField; aSQL: string{ = UseParamSQL}): Boolean;
var
ErrCode: integer;
begin
FField:=nil;
FCol:=0;
FRow:=0;
FEmptyResult:=True;
FFireUserCallBacks:=True;
FInternalNewRow:=@FieldNewRow;
FInternalNewCol:=@FieldNewCol;
FInternalEndRow:=@CommonEndRow;
Result:=Execute(aSQL);
if Result
then begin
ErrCode:=SQLITE_OK;
if FEmptyResult or not Assigned(FField) then
ErrCode:=LYSQLITEDB_EMPTYRESULT;
if FRow>1 then
ErrCode:=LYSQLITEDB_TOOMANYROWS;
if FCol>1 then
ErrCode:=LYSQLITEDB_TOOMANYCOLS;
end
else ErrCode:=LYSQLITEDB_SQLITEERROR;
Result := ( setLastError(ErrCode) = SQLITE_OK );
aField:=FField; // vaut nil ou dernier champ du résultat
FInternalNewRow:=nil;
FInternalNewCol:=nil;
FInternalEndRow:=nil;
end;

// exécute la requête et renvoie la valeur dans une chaîne
function TlySQLiteDB.ToString(var aString: string; aSQL: string{ = UseParamSQL}): Boolean; // overload ;
var
Field:TlyField;
begin
Result:=ToField(Field, aSQL);
if Result
then aString:=Field.AsText
else aString:=EmptyStr;
FreeAndNil(Field);
end;

Requêtes à résultat en colonne :

D'autres requêtes retournent un résultat sous forme de plusieurs lignes d'une seule colonne : SELECT nom FROM employes WHERE id > 5.
La fonction FirstColToStrings leur est dédiée. Elle va peupler une liste de chaînes (TStrings) avec la valeur de chaque ligne de la première colonne (et signaler au besoin que le résultat est tronqué à la première s'il avait plusieurs colonnes).
Elle définit les CallBacks nécessaires et gère les erreurs qui lui sont propres.

procedure TlySQLiteDB.StringsNewRow(aSender: TObject; aColCount: integer);
begin
if (FRow=0) then begin
if aColCount>FColsWanted
then FErr:=LYSQLITEDB_TOOMANYCOLS;
if aColCount=FColsWanted-1
then FErr:=LYSQLITEDB_LACKSONECOL;
end;
FCol:=0;
end;

procedure TlySQLiteDB.StringsNewCol(aSender: TObject; aColumn: string; aValue: string);
begin
if FCol=0 // on ne renvoie que la première colonne
then begin
FStrings.Add(aValue);
FCol:=1;
end;
end;

// exécute la requête et renvoie la première colonne du résultat
function TlySQLiteDB.FirstColToStrings(aStrings: TStrings; aSQL: string = UseParamSQL): Boolean;
var
ErrCode: integer;
begin
if aStrings is TStrings
then begin
FStrings:=aStrings;
FStrings.Clear;
FColsWanted:=1; // on ne veut qu'une colonne
FRow:=0;
FEmptyResult:=True;
FErr:=SQLITE_OK;
FFireUserCallBacks:=True;
FInternalNewRow:=@StringsNewRow;
FInternalNewCol:=@StringsNewCol;
FInternalEndRow:=@CommonEndRow;
Result:=Execute(aSQL);
if Result
then begin
if FEmptyResult
then ErrCode:=LYSQLITEDB_EMPTYRESULT
else ErrCode:=FErr; // pê positionné à LYSQLITEDB_TOOMANYCOLS par StringsNewRow
end
else ErrCode:=LYSQLITEDB_SQLITEERROR;
FInternalNewRow:=nil;
FInternalNewCol:=nil;
FInternalEndRow:=nil;
end
else ErrCode:=LYSQLITEDB_NOTASSIGNED;
Result := (setLastError(ErrCode) = SQLITE_OK);
end;

Une fonction TwoColsToIniStrings est proposée pour fusionner les valeurs des deux colonnes du résultat dans une liste de chaîne en les agrégeant au format 'Name=Value' (comme dans un fichier ini, avec le résultat de la première colonne comme Name et celui de la seconde comme Value) de façon à pouvoir retrouver le résultat 'colonne2' en appelant TStrings.Values['colonne1'].

// exécute la requête et renvoie les 2 premières colonnes du résultat au format ini Column1=Column2
function TlySQLiteDB.TwoColsToIniStrings(aStrings: TStrings; aSQL: string{ = UseParamSQL}): Boolean;
var
ErrCode: integer;
begin
if aStrings is TStrings
then begin
FStrings:=aStrings;
FStrings.Clear;
FColsWanted:=2; // on veut deux colonnes
FRow:=0;
FEmptyResult:=True;
FErr:=SQLITE_OK;
FFireUserCallBacks:=True;
FInternalNewRow:=@StringsNewRow;
FInternalNewCol:=@StringsTwoCols;
FInternalEndRow:=@CommonEndRow;
Result:=Execute(aSQL);
if Result
then begin
if FEmptyResult
then ErrCode:=LYSQLITEDB_EMPTYRESULT
else ErrCode:=FErr; // pê positionné à LYSQLITEDB_TOOMANYCOLS ou LYSQLITEDB_LACKSONECOL par StringsNewRow
end
else ErrCode:=LYSQLITEDB_SQLITEERROR;
FInternalNewRow:=nil;
FInternalNewCol:=nil;
FInternalEndRow:=nil;
end
else ErrCode:=LYSQLITEDB_NOTASSIGNED;
Result := (setLastError(ErrCode) = SQLITE_OK);
end;

Requêtes à résultat en ligne :

Il existe des requêtes retournant leur résultat sous la forme d'une seule ligne, comprenant une ou plusieurs colonnes : SELECT * FROM employes WHERE id = 2.
C'est la fonction FirstLineToStrings qui leur est dévolue. Elle va peupler une liste de chaînes (TStrings) avec la valeur de chaque colonne de la première ligne (et signaler au besoin que le résultat est tronqué à la première s'il avait plusieurs lignes). Comme SQLite renvoie les noms de colonnes et leur valeur, un sélecteur permet de récupérer le résultat au format ini Name=Value.
Les CallBacks sont à nouveau fort simples :

procedure TlySQLiteDB.ValuesNewRow(aSender: TObject; aColCount: integer);
begin
Inc(FRow);
if FRow>1
then FErr:=LYSQLITEDB_TOOMANYROWS;
end;

procedure TlySQLiteDB.ValuesNewCol(aSender: TObject; aColumn: string; aValue: string);
begin
if FRow=1 // on ne renvoie que la première ligne
then begin
if FIniStyle
then FStrings.Add(aColumn+FStrings.NameValueSeparator+aValue)
else FStrings.Add(aValue);
end;
end;

// exécute la requête et renvoie la première ligne du résultat (au format ini ColumnName=Value sur option)
function TlySQLiteDB.FirstLineToStrings(aStrings: TStrings; aSQL: string{ = UseParamSQL}; aIniStyle: Boolean{ = False}): Boolean;
var
ErrCode: integer;
begin
if aStrings is TStrings
then begin
FStrings:=aStrings;
FStrings.Clear;
FIniStyle:=aIniStyle;
FRow:=0;
FEmptyResult:=True;
FErr:=SQLITE_OK;
FFireUserCallBacks:=True;
FInternalNewRow:=@ValuesNewRow;
FInternalNewCol:=@ValuesNewCol;
FInternalEndRow:=@CommonEndRow;
Result:=Execute(aSQL);
if Result
then begin
ErrCode:=SQLITE_OK;
if FEmptyResult
then ErrCode:=LYSQLITEDB_EMPTYRESULT
else ErrCode:=FErr; // pê positionné à LYSQLITEDB_TOOMANYROWS par Execute
end;
FInternalNewRow:=nil;
FInternalNewCol:=nil;
FInternalEndRow:=nil;
end
else ErrCode:=LYSQLITEDB_NOTASSIGNED;
Result := (setLastError(ErrCode) = SQLITE_OK);
end;

Requêtes à résultat en tableau :

Il est fréquent qu'une requête ait pour résultat un tableau de plusieurs lignes de plusieurs colonnes. La grille de chaînes en est le destinataire naturel, et la fonction ToStringGrid se charge de le lui affecter. Par choix, elle va ajouter une ligne de titres pour les noms des champs (colonnes) et une colonne de titre pour numéroter les lignes de résultat.

:fleche: Ceci pourrait facilement être rendu optionnel en ajoutant un sélecteur pour la numérotation des lignes et les titres des colonnes.

Les CallBacks ne sont guère compliquées :

procedure TlySQLiteDB.GridNewRow(aSender: TObject; aColCount: integer);
begin
FCol:=0;
if FRow=0
then begin
FGrid.ColCount:=aColCount+1; // car colonne de titre
FGrid.RowCount:=1; // cad colonne de titre
FGrid.Cells[0, 0]:='*'; // titre grille
end;
Inc(FRow); // ajout de la ligne
FGrid.RowCount:=FRow+1; // car colonne de titre
FGrid.Cells[FCol, FRow]:=IntToStr(FRow); // indice de la ligne en colonne titre
Inc(FCol); // prochaine colonne à écrire
end;

procedure TlySQLiteDB.GridNewCol(aSender: TObject; aColumn: string; aValue: string);
begin
if FRow=1
then FGrid.Cells[FCol, 0]:=aColumn; // titre
FGrid.Cells[FCol, FRow]:=aValue;
Inc(FCol);
end;

// exécute la requête et renvoie le résultat dans la grille
function TlySQLiteDB.ToStringGrid(aGrid: TStringGrid; aSQL: string{ = UseParamSQL}): Boolean;
var
ErrCode: integer;
begin
if aGrid is TStringGrid
then begin
FGrid:=aGrid;
FRow:=0;
FEmptyResult:=True;
FFireUserCallBacks:=True;
FInternalNewRow:=@GridNewRow;
FInternalNewCol:=@GridNewCol;
FInternalEndRow:=@CommonEndRow;
Result:=Execute(aSQL);
if Result
then begin
if FEmptyResult
then ErrCode:=LYSQLITEDB_EMPTYRESULT
else ErrCode:=SQLITE_OK;
end
else ErrCode:=LYSQLITEDB_SQLITEERROR;
FInternalNewRow:=nil;
FInternalNewCol:=nil;
FInternalEndRow:=nil;
end
else ErrCode:=LYSQLITEDB_NOTASSIGNED;
Result := (setLastError(ErrCode) = SQLITE_OK);
end;

Accès aux BLOBs :

Ces champs sont particuliers et leur manipulation passe par des fonctions dédiées de l'API SQLIte. Ils nécessitent d'être ouverts en lecture ou écriture avant que ces opérations puissent intervenir. Afin d'éviter de bloquer le Close en cas de BLOBs non refermés, ils seront refermés immédiatement après accès.

:alerte: On ne peut écrire dans un BLOB inexistant, ni modifier sa taille. La première étape est donc de créer le champ BLOB à la taille voulue, à l'aide de la fonction SQL zeroblob(N) qui initialise un champ BLOB à N octets nuls : INSERT INTO adherents ( nom, photo ) VALUES ( ''toto'', zeroblob(8743) ).

Avant écriture, l'utilisateur est donc en charge de la création préalable d'un champ BLOB suffisamment grand.

:fleche: Dans un souci de simplicité, un BLOB peut ne pas être écrit en entier, mais est toujours accédé à partir du début (ce qui est une limitation par rapport à l'API SQLite).

Le choix s'est porté sur une interface avec des Streams, conteneurs « logiques » pour des BLOBs. Dans le cas (simple et fréquent) où l'on voudra écrire un BLOB juste inséré, le paramètre aRow pourra être omis.

SQLite attend le nom symbolique de la base, soit son alias, et non le chemin du fichier. Ce sera donc 'main' pour la base principale, 'temp' pour une base temporaire, l'alias fourni après AS pour un ATTACH, etc.
Passer par un TMemoryStream interne intermédiaire permet d'avoir accès à sa propriété Memory qui correspond à un pointeur sur le buffer requis par l'API. Voici le code pour l'écriture d'une portion d'un flux dans un champ BLOB :

function TlySQLiteDB.StreamToBlob(aStream: TStream; aSize, aOffset: integer; aDBSymbolicName, aTable, aColumn: string;
aRow: integer = LAST_INSERT_ROWID): Boolean;
var
pBlob: PSQLiteBLOB;
Error: PChar;
tms: TMemoryStream;
ErrCode, iSize, OldPos, ErrClose: integer;
begin
if aStream is TStream
then begin
if aRow=LAST_INSERT_ROWID
then aRow:=LastInsertRowId;
Error:=nil;
pBlob:=nil;
ErrCode:=sqlite3_blob_open(DB, PChar(aDBSymbolicName), PChar(aTable), PChar(aColumn), aRow, True, pBlob);
if ErrCode=SQLITE_OK
then begin
iSize:=sqlite3_blob_bytes(pBlob);
if iSize then ErrCode:=LYSQLITEDB_SIZEBLOBERR
else begin
tms:=TMemoryStream.Create;
OldPos:=aStream.Position;
aStream.Position:=aOffset;
tms.CopyFrom(aStream, aSize);
aStream.Position:=OldPos;
ErrCode:=sqlite3_blob_write(pBlob, tms.Memory^, aSize, 0);
end;
tms.Free;
end;
ErrClose:=sqlite3_blob_close(pBlob);
if ErrCode=SQLITE_OK
then ErrCode:=ErrClose;
if ErrCode<>SQLITE_OK
then begin
FLastErrorCode:=ErrCode;
Error:=sqlite3_errmsg;
FLastErrorMsg:=StrPas(Error);
DoLog('Error : '+FLastErrorMsg+#10#13
+' while writing BLOB : '+aDBSymbolicName+'.'+aTable+'.'+aColumn+' @ Row '+IntToStr(aRow));
end;
end
else ErrCode:=LYSQLITEDB_NOTASSIGNED;
Result := (setLastError(ErrCode) = SQLITE_OK);
end;

On a un code très symétrique pour la lecture du BLOB dans un flux :

function TlySQLiteDB.BlobToStream(aDBSymbolicName, aTable, aColumn: string; aRow: integer; aStream: TStream): Boolean;
var
pBlob: PSQLiteBLOB;
Error: PChar;
tms: TMemoryStream;
ErrCode, iSize, ErrClose: integer;
begin
if aStream is TStream
then begin
if aRow=LAST_INSERT_ROWID
then aRow:=LastInsertRowId;
Error:=nil;
pBlob:=nil;
ErrCode:=sqlite3_blob_open(DB, PChar(aDBSymbolicName), PChar(aTable), PChar(aColumn), aRow, False, pBlob);
if ErrCode=SQLITE_OK
then begin
iSize:=sqlite3_blob_bytes(pBlob);
tms:=TMemoryStream.Create;
tms.SetSize(iSize);
ErrCode:=sqlite3_blob_read(pBlob, tms.Memory^, iSize, 0);
if ErrCode=SQLITE_OK
then begin
tms.Position:=0;
aStream.Seek(0, soFromEnd);
aStream.CopyFrom(tms, iSize);
end;
tms.Free;
end;
ErrClose:=sqlite3_blob_close(pBlob);
if ErrCode=SQLITE_OK
then ErrCode:=ErrClose;
if ErrCode<>SQLITE_OK
then begin
FLastErrorCode:=ErrCode;
FLastErrorMsg:=StrPas(Error);
sqlite3_free(Error);
DoLog('Error : '+FLastErrorMsg+#10#13
+' while reading BLOB : '+aDBSymbolicName+'.'+aTable+'.'+aColumn+' @ Row '+IntToStr(aRow));
end;
end
else ErrCode:=LYSQLITEDB_NOTASSIGNED;
Result := (setLastError(ErrCode) = SQLITE_OK);
end;

Divers :

Comme on a pu le voir dans l'interface, plusieurs propriétés y sont exposées et rapidement présentées. Elles sont en principe suffisamment explicites pour éviter d'y revenir.
Quelques accesseurs (getter/setter) ont déjà été vus (pour la gestion de la journalisation, par exemple) ; reste ceux dédiés à quelques propriétés et aux gestionnaires de progression.
Pour les propriétés restantes, les getters interfacent l'API SQLite ou font une requête :

function TlySQLiteDB.getVersion: string;
begin
Result:=StrPas(sqlite3_libversion);
end;

function TlySQLiteDB.getCharset: string;
var
S: String;
begin
if Assigned(DB) and ToString(S, 'PRAGMA encoding')
then Result:=S
else Result:=EmptyStr;
end;

function TlySQLiteDB.getRowId: integer;
begin
Result:=-1;
if Assigned(DB)
then Result:=sqlite3_LAST_INSERT_ROWID(DB); // retourne 0 ou RowId
end;

Pour les gestionnaires de progression, une CallBack interne permet de toujours gérer l'événement, même si celle utilisateur n'est pas définie. Cette fonction de rappel interne ne sert qu'à déclencher l'éventuelle CallBack utilisateur.

:alerte: C'est lorsqu'on attribue une valeur à ProgressInterval que l'appel SQLite est fait pour passer le gestionnaire d'événement et la fréquence. Or cet appel requiert une connexion à la base. En absence de base ouverte, l'intervalle est remis à zéro, sans message d'erreur ni exception. Il convient donc de vérifier qu'une base est connectée ou que l'attribution s'est bien faite.

function SQLiteProgress(aSender: TObject): integer; cdecl;
var
DB: TlySQLiteDB;
begin
DB:=TlySQLiteDB(aSender);
if Assigned(DB.OnProgress)
then Result:=DB.OnProgress(aSender)
else Result:=SQLITE_OK; // une autre valeur interrompt la requête
end;

procedure TlySQLiteDB.setInterval(aValue: integer);
begin
if Assigned(DB) // on a toujours l'événement géré, même si FOnProgress = nil
then begin
FProgressInterval:=aValue;
sqlite3_progress_handler(DB, FProgressInterval, @SQLiteProgress, self);
end
else FProgressInterval:=0; // cad jamais appelé
end;

procedure TlySQLiteDB.setOnProgress(aValue: TOnProgress);
begin
if Assigned(DB)
then begin
FOnProgress:=aValue;
sqlite3_progress_handler(DB, FProgressInterval, @SQLiteProgress, self);
end
else FOnProgress:=nil; // donc non enregistré (faudrait-il lever une exception ?)
end;

On peut enfin dévoiler ce qui ne l'est pas dans l'interface publique, à savoir les champs privés ou protégés :

TlySQLiteDB = class
private
FRow, FCol, FErr, FColsWanted: integer;
FEmptyResult, FIniStyle, FFireUserCallBacks: Boolean;
FLast: string;
FGrid: TStringGrid;
FStrings: TStrings;
FField: TlyField;
FCallErrorCode: integer;
FCallErrorMsg: string;
FLastErrorCode: integer;
FInternalNewRow: TOnNewRow;
FInternalNewCol: TOnNewCol;
FInternalEndRow: TOnEndRow;
FUserNewRow: TOnNewRow;
FUserNewCol: TOnNewCol;
FUserEndRow: TOnEndRow;
FOnProgress: TOnProgress;
FProgressInterval: integer;
FOnLog: TOnLog;
FUserLog: TOnLog;
FAutoLog: Boolean;
FLogRequests: Boolean;
FParamSQL: TlyParamSQL;
protected
DB: PSQLiteDB;
DBName: TFileName;
FLastErrorMsg: string;
LogFileName: TFileName;
function getVersion: string;
function getCharset: string;
function getRowId: integer;
function setLastError(aCode: integer): integer;
procedure setAutoLog(aValue: Boolean);
procedure setUserLog(aValue: TOnLog);
procedure setOnProgress(aValue: TOnProgress);
procedure DoLog(aText: string);
procedure LogIt(aSender: TObject; aText: string);
procedure setInterval(aValue: integer);
procedure FieldNewRow(aSender: TObject; aColCount: integer);
procedure FieldNewCol(aSender: TObject; aColumn: string; aValue: string);
procedure CommonEndRow(aSender: TObject);
procedure GridNewRow(aSender: TObject; aColCount: integer);
procedure GridNewCol(aSender: TObject; aColumn: string; aValue: string);
procedure StringsNewRow(aSender: TObject; aColCount: integer);
procedure StringsNewCol(aSender: TObject; aColumn: string; aValue: string);
procedure StringsTwoCols(aSender: TObject; aColumn: string; aValue: string);
procedure CountNewRow(aSender: TObject; aColCount: integer);
procedure ValuesNewRow(aSender: TObject; aColCount: integer);
procedure ValuesNewCol(aSender: TObject; aColumn: string; aValue: string);
public
// déjà vu !
end;

Il ne nous reste donc plus qu'à voir comment mettre tout ceci en œuvre, au travers d'exemples d'utilisation en illustrant les différentes facettes.

Exemple d'utilisation :

Ce n'est pas en lisant le carnet de bord qu'on apprend à conduire, alors rien de tel que de se glisser au volant ! Pour ça, rien ne remplace une fiche avec un bouton, une StringGrid, un TImage et un Memo :

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Grids, lySqlite3Intf, lySQLite3Param, lySqlite3DB;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: Tbutton;
Label1: TLabel;
ComboBox1: TComboBox;
StringGrid1: TStringGrid;
Image1: Timage;
Memo1: Tmemo;
procedure MemoLog(aSender: TObject; aText: string);
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;

var
Form1: TForm1;

implementation

Pour les besoins de la démonstration, vous remplacerez dans le code du bouton la valeur de la constante Path_Photo par le chemin d'une de vos images. Il se créera dans son répertoire une base à son nom, d'extension 'bdd'.

:alerte: Sous Lazarus, mieux vaut éviter les caractères accentués dans les chemins et respecter sous Windows les contraintes que Linux impose.

On va loger dans le code du bouton l'utilisation d'à peu près tous les types de fonctions de l'objet. Pour avoir le retour des événements log, on a d'abord défini une CallBack, MemoLog, qui affichera dans le Memo. Le code devrait être suffisamment parlant à l'écriture et à l'exécution pour se passer d'autres commentaires.

{ TForm1 }

procedure TForm1.MemoLog(aSender: TObject; aText: string);
begin
Memo1.Lines.Add(' >'+aText);
end;

procedure TForm1.Button1Click(Sender: Tobject);

const
Path_Photo = 'c:\userfiles\test.jpg'; // à personnaliser !

var
MyBd: TlySQLiteDB;
SQList: TStringList;
S, SQL: string;
c,r,i: integer;
Field: TlyField;
flux: TmemoryStream;

begin
Memo1.Clear;
MyBd:=TlySQLiteDB.Create;
MyBd.AutoLog:=False;
MyBd.OnLog:=@MemoLog;
MyBd.LogRequests:=True;
Memo1.Lines.Add('***** connexion/déconnexion à la base *****');
// on devrait tester les valeurs de retour de toutes les fonctions,
// mais comme on a le log, on va alléger le code pour la lisibilité
if MyBd.Open(ChangeFileExt(Path_Photo, '.bdd'))
then MyBd.Close
else Memo1.Lines.Add(MyBD.LastErrorMsg);
Memo1.Lines.Add('***** connexion à la base *****');
MyBd.Open(ChangeFileExt(Path_Photo, '.bdd'));
Memo1.Lines.Add('***** accès à des propriétés, avec requête générée pour le charset *****');
Memo1.Lines.Add(' MyBd.FileName = '+MyBd.FileName);
Memo1.Lines.Add(' MyBd.Charset = '+MyBd.Charset);
Memo1.Lines.Add('***** (re)création de la table, utilisation de Execute(TStrings) *****');
SQList:=TStringList.Create;
SQList.Add('CREATE TABLE IF NOT EXISTS employes ( id INTEGER PRIMARY KEY , nom TEXT , age INTEGER , photo BLOB )');
SQList.Add('DELETE FROM employes');
SQList.Add('INSERT INTO employes ( nom , age ) VALUES ( "toto" , 50 )');
SQList.Add('INSERT INTO employes ( nom , age ) VALUES ( "tata" , 25 )');
MyBd.Execute(SQList);
Memo1.Lines.Add('***** appel de ToStringGrid avec puis sans erreur *****');
MyBd.ToStringGrid(StringGrid1, 'SELECT * FROM employe');
MyBd.ToStringGrid(StringGrid1, 'SELECT * FROM employes');
StringGrid1.Refresh;
Memo1.Lines.Add('***** appel de Count *****');
MyBd.Count(r, c, 'SELECT * FROM employes');
Memo1.Lines.Add(Format(' MyBd.Count renvoie %0:1X lignes de %1:1X colonnes, comme on peut le vérifier dans la grille', [r, c]));
Memo1.Lines.Add('***** ajout d''un employé par Execute(String) *****');
flux:=TMemoryStream.Create;
flux.LoadFromFile(Path_Photo);
i:=flux.Size;
MyBd.Execute('INSERT INTO employes ( nom , age , photo ) VALUES ( "titi" , 31 , zeroblob('+IntToStr(i)+') )');
Memo1.Lines.Add('***** ajout de sa photo grâce à StreamToBlob *****');
MyBd.StreamToBlob(flux, i, 0, 'main', 'employes', 'photo');
Memo1.Lines.Add('***** récupération de l''id de cet employé grâce à ToField *****');
flux.Clear;
MyBd.ToField(Field, 'SELECT id FROM employes WHERE nom = "titi"');
i:=Field.AsInteger;
Memo1.Lines.Add('***** affichage de la photo de ce dernier employé grâce à BlobToStream *****');
if MyBd.BlobToStream('main', 'employes', 'photo', i, flux)
then begin
flux.Position:=0;
Image1.Picture.LoadFromStreamWithFileExt(flux, 'jpg');
Image1.Refresh;
flux.Free;
end;
Memo1.Lines.Add('***** et de son âge grâce à ToString et une requête paramétrée *****');
S:='SELECT :param_age: FROM employes WHERE id = :param_id:';
Memo1.Lines.Add('ParamSQL = "'+S+'"');
MyBd.ParamSQL.Request:=S;
MyBd.ParamSQL.Params.AsSQL:='age';
MyBd.ParamSQL.ParamByName('param_id').AsInteger:=i;
MyBd.ToString(S);
Memo1.Lines.Add('titi a '+S+' ans');
Memo1.Lines.Add('***** affichage des noms de tous les employés grâce à FirstColToStrings *****');
MyBd.FirstColToStrings(SQList, 'SELECT nom FROM employes');
Memo1.Lines.Add(SQList.Text);
Memo1.Lines.Add('***** le même avec une erreur (plus d''une colonne dans la reqête) *****');
if not MyBd.FirstColToStrings(SQList, 'SELECT nom, age FROM employes')
then Memo1.Lines.Add('Erreur '+IntToStr(MyBd.LastErrorCode)+' : '+MyBd.LastErrorMsg);
Memo1.Lines.Add(SQList.Text);
Memo1.Lines.Add('***** affichage des champs d''un employé grâce à FirstLineToStrings *****');
MyBd.FirstLineToStrings(SQList, 'SELECT * FROM employes WHERE nom = "toto"');
Memo1.Lines.Add(SQList.Text);
Memo1.Lines.Add('***** le même au style ini *****');
MyBd.FirstLineToStrings(SQList, 'SELECT * FROM employes WHERE nom = "toto"', True);
Memo1.Lines.Add(SQList.Text);
Memo1.Lines.Add('***** affichage des couples nom/âge de tous les employés grâce à TwoColsToIniStrings *****');
MyBd.TwoColsToIniStrings(SQList, 'SELECT nom, age FROM employes');
Memo1.Lines.Add(SQList.Text);
SQList.Free;
Memo1.Lines.Add('***** et comme les meilleures choses ont une fin *****');
MyBd.Free;
end;

end.

Conclusion :

L'utilisation d'une base SQLite est a priori facilitée par cette objet encapsulant les appels à l'API. Nous allons donc pouvoir refermer le capot sur ce moteur et il ne restera plus qu'à s'en servir !

Comme on peut avoir besoin de stocker des informations confidentielles sous forme cryptée, il suffit de crypter chaque champ. Mais ceci est fastidieux et alourdit le code : mieux vaudrait crypter/décrypter à la volée, de façon transparente. Ceci fera l'objet du billet suivant.

Vous trouverez les unités ici : Billet_numero_3.zip