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 :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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 - Visualiser dans une fenêtre à part

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