Vous êtes nouveau sur Developpez.com ? Créez votre compte ou connectez-vous afin de pouvoir participer !

Vous devez avoir un compte Developpez.com et être connecté pour pouvoir participer aux discussions.

Vous n'avez pas encore de compte Developpez.com ? Créez-en un en quelques instants, c'est entièrement gratuit !

Si vous disposez déjà d'un compte et qu'il est bien activé, connectez-vous à l'aide du formulaire ci-dessous.

Identifiez-vous
Identifiant
Mot de passe
Mot de passe oublié ?
Créer un compte

L'inscription est gratuite et ne vous prendra que quelques instants !

Je m'inscris !

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

Le , par tourlourou

0PARTAGES

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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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é :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
// 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.

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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
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.

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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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.

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.

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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;

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.

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.

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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.

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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 !

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
// 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.

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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[j]); 
      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 :

Code SQL : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
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.

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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'].

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
  // 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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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.

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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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.

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.

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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
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<aSize 
      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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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.

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.

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
  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 :

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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'.

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.

Code Pascal : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
{ 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[0].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

Une erreur dans cette actualité ? Signalez-le nous !