Pascal : SQLite sous Windows, cryptage à la volée,

Un billet de Tourlourou

1
2
3
4
5
6
7
8
9
10
11
12
13
14
unit lySQLite3OSIntf; 
  
interface 
  
uses 
  SysUtils, lySQLite3Intf; 
  
const 
  // informations de versions pour SQLite 3.7.17 
  MinVersion = 3007017;  
  IO_Version = 3; 
  VfsVersion = 3; 
  Win32VFSName = 'win32'; 
  WinFileStructLength = 72;

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
type 
  // pointeurs sur structures ou méthodes 
  PSQLiteVFS  = ^TSQLiteVFS;  // système de fichier virtuel 
  PSystemCall = Pointer;      // adresse des méthodes systèmes internes à la VFS   
  
  // caractéristiques d'un VFS (Système de Fichier Virtuel) 
  TSQLiteVFS = record 
    // champs de la version 1 (à partir 3.5.0) 
    Version: integer;    // VfsVersion = 3 pour la version 3.7.17 de SQLite 
    szOsFile: integer;   // taille de la structure SQLite3_File retournée (champs personnels additionnels possibles) 
    mxPathname: integer; // Maximum file pathname length 
    Next: PSQLiteVFS;    // interne à SQLite : pas touche ! 
    Name: PChar;     // Name of this virtual file system : doit être unique 
    AppData: Pointer;    // Pointer to application-specific data 
    // si Name = nil => utiliser nom temporaire propre au VFS 
    // OutFlags doit refléter SQLITE_OPEN_READONLY si besoin 
    Open:   function(aVFS: PSQLiteVFS; aName: PAnsiChar; aFile: PSQLiteFile; aFlags: integer; var aOutFlags: integer): integer; cdecl;         
    Delete: function(aVFS: PSQLiteVFS; aName: PAnsiChar; aSyncDir: LongBool): integer; cdecl;    
    Access: function(aVFS: PSQLiteVFS; aName: PAnsiChar; aFlags: integer; var aOutFlags: integer): integer; cdecl;        
    FullPathName: function(aVFS: PSQLiteVFS; aRelativePath: PChar; aFullPathSize: integer; aFullPath: PChar): integer; cdecl; 
    // 4 fonctions liées aux librairies dynamiques 
    DlOpen:   function(aVFS: PSQLiteVFS; aFileName: PChar): Pointer; cdecl; 
    DlError: procedure(aVFS: PSQLiteVFS; aBufferSize: integer; aBuffer: PChar); cdecl; 
    DlSym:    function(aVFS: PSQLiteVFS; aAddress: Pointer; aProcName: PChar): Pointer; cdecl; // pour Symbol = GetProcAddress 
    DlClose: procedure(aVFS: PSQLiteVFS; aHandle: Pointer); cdecl; 
    // pour initialisation générateur interne 
    Randomness:   function(aVFS: PSQLiteVFS; aBufferSize: integer; aBuffer: PChar): integer; cdecl;  
    Sleep:        function(aVFS: PSQLiteVFS; aMicroSeconds: integer): integer; cdecl; 
    CurrentTime:  function(aVFS: PSQLiteVFS; var aNow: Double): integer; cdecl; 
    GetLastError: function(aVFS: PSQLiteVFS; aBufferSize: integer; aBuffer: PChar): integer; cdecl; 
    // champs de la version 2 (à partir 3.x.x) 
    CurrentTime64: function(aVFS: PSQLiteVFS; var aNow: int64): integer; cdecl; // SQLite utilisera CurrentTime si fonction non disponible 
    // champs de la version 3 ; donnent accès pour débogage aux adresses des méthodes systèmes internes au VFS (à partir 3.7.6) 
      // principe étendu à tous les appels à partir de la 3.7.10 
    SetSystemCall:  function(aVFS: PSQLiteVFS; aName: PChar; aSystemCall: PSystemCall): integer; cdecl; 
    GetSystemCall:  function(aVFS: PSQLiteVFS; aName: PChar): PSystemCall; cdecl; 
    NextSystemCall: function(aVFS: PSQLiteVFS; aName: PChar): PChar; cdecl; 
    // Additional fields may be added in future releases (i.e. > 3.7.17 and Version > 3) 
  end;

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
type 
  // pointeurs sur structures de manipulation du fichier 
  PSQLiteFile = ^TSQLiteFile; // fichier ouvert 
  
  // méthodes d'accès aux fichiers ouverts décrits dans des objets SQLite3_File 
  TSQLiteIO = record 
    // méthodes de la version 1 (à partir 3.5.0) 
    Version: integer; // IO_Version = 3 pour la version 3.7.17 de SQLite 
    Close: function(aFile: PSQLiteFile): integer; cdecl;  
    Read: function(aFile: PSQLiteFile; aData: PByteArray; aSize: integer; aOffset: int64): integer; cdecl;   
    Write: function(aFile: PSQLiteFile; aData: PByteArray; aSize: integer; aOffset: int64): integer; cdecl;   
    Truncate: function(aFile: PSQLiteFile; aSize: int64): integer; cdecl;  
    Sync: function(aFile: PSQLiteFile; aFlags: integer): integer; cdecl; 
    FileSize: function(aFile: PSQLiteFile; var aSize: int64): integer; cdecl;  
    Lock: function(aFile: PSQLiteFile; aLocktype: integer): integer; cdecl;  
    Unlock: function(aFile: PSQLiteFile; aLocktype: integer): integer; cdecl;  
    CheckReservedLock: function(aFile: PSQLiteFile; var aResOut: LongBool): integer; cdecl;   
    FileControl: function(aFile: PSQLiteFile; aOpCode: integer; aArg: Pointer): integer; cdecl;    
    SectorSize: function(aFile: PSQLiteFile): integer; cdecl;  
    DeviceCharacteristics: function(aFile: PSQLiteFile): integer; cdecl;  
    // méthodes de la version 2 (gestion de la mémoire partagée, nécessaire au mode WAL = Write-Ahead Logging ; à partir 3.7.0 ?) 
    ShmMap: function(aFile: PSQLiteFile; aPage, aPageSize: integer; aExtendFile: LongBool; var aPMapping: Pointer): integer; cdecl; 
    ShmLock: function(aFile: PSQLiteFile; aOffset, aNb, aFlags: integer): integer; cdecl;  
    ShmBarrier: procedure(aFile: PSQLiteFile); cdecl; 
    ShmUnMap: function(aFile: PSQLiteFile; aDeleteFlag: integer): integer; cdecl; 
    // méthodes de la version 3 (pour le mappage des fichiers en mémoire, à partir 3.7.17) 
    Fetch: function(aFile: PSQLiteFile; aOffset: int64; aSize: integer; var aPMapping: Pointer): integer; cdecl;    
    UnFetch: function(aFile: PSQLiteFile; aOffset: int64; aPMapping: Pointer): integer; cdecl;            
    // Additional methods may be added in future releases (i.e. > 3.7.17 and Version > 3) 
  end;

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
type 
  // pointeurs sur structures de manipulation du fichier 
  PSQLiteIO   = ^TSQLiteIO;   // méthodes d'accès au fichier  
  
  // structure des données pour la manipulation du fichier ouvert par la méthode Open de la VFS de Win32 
  // code traduit de l'unité os_win.c du source de la bibliothèque SQLite3 
  // le reste est documenté dans l'aide de SQLite3, mais pas cet aspect. 
  // A l'exécution, la taille de cette structure est de 72 octets 
  // du fait de l'alignement pair des données de type Byte. 
  // Traduction en packed record avec des octets vides. 
  TSQLiteFile = packed record 
    IO_Methods: PSQLiteIO;            // Methods for an opened file 
    PVFS: PSQLiteVFS;                // The VFS used to open this file 
    HFile: THandle;                 // Handle for accessing the file 
    LockType: Byte;                // Type of lock currently held on this file 
    __NotUsed1: Byte;             // Padding 
    SharedLockByte: Byte;        // Randomly chosen byte used as a shared lock 
    __NotUsed2: Byte;           // Padding 
    CtrlFlags: Byte;           // WINFILE_PERSIST_WAL = $4 et/ou WINFILE_PSOW = $10 (POWERSAFE_OVERWRITE) 
    __NotUsed3: Byte;         // Padding 
    __NotUsed4: Word;        // Padding 
    LastErrNo: Cardinal;    // The Windows errno from the last I/O error 
    PShm: Pointer;         // Instance of shared memory on this file 
    Path: PAnsiChar;      // Full pathname of this file 
    ChunkSize: integer;  // Chunk size configured by FCNTL_CHUNK_SIZE 
    // plus 36 octets de données ajoutés pour le mappage des fichiers en mémoire, à partir 3.7.17 
    nFetchOut: integer;    // Number of outstanding xFetch references 
    hMap: THandle;         // Handle for accessing memory mapping 
    pMapRegion: Pointer;   // Area memory mapped 
    mmapSize: int64;       // Usable size of mapped region 
    mmapSizeActual: int64; // Actual size of mapped region 
    mmapSizeMax: int64;    // Configured FCNTL_MMAP_SIZE value 
  end;

1
2
3
4
5
6
7
// procédures relatives aux VFS 
function sqlite3_vfs_find(aVfsName: PChar): PSQLiteVFS; cdecl; external DllName; 
function sqlite3_vfs_register(aVFS: PSQLiteVFS; aMakeDefault: LongBool): integer; cdecl; external DllName; 
function sqlite3_vfs_unregister(aVFS: PSQLiteVFS): integer; cdecl; external DllName; 
  
// ouverture fichier en spécifiant le nom de la VFS à utiliser 
function sqlite3_open_v2(aFileName: PChar; var aDB: PSQLiteDB; aOpenMode: integer; aVfsName: PChar): integer; cdecl; external DllName;

1
2
3
4
5
6
7
8
9
10
implementation 
  
initialization 
  if MinVersion > sqlite3_libversion_number 
  then raise Exception.Create('Cryptage prévu seulement pour SQLite 3.7.17 ou supérieur ; ici : ' + sqlite3_libversion); 
  
finalization 
  // DoNone 
  
end.

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
/* 
** Many system calls are accessed through pointer-to-functions so that 
** they may be overridden at runtime to facilitate fault injection during 
** testing and sandboxing.  The following array holds the names and pointers 
** to all overrideable system calls. 
*/ 
  
static struct win_syscall { 
  const char *zName;            /* Name of the system call */ 
  sqlite3_syscall_ptr pCurrent; /* Current value of the system call */ 
  sqlite3_syscall_ptr pDefault; /* Default value */ 
} aSyscall[] = { 
  
// first calls here 
  
  { "ReadFile",                (SYSCALL)ReadFile,                0 }, 
  
#define osReadFile ((BOOL(WINAPI*)(HANDLE,LPVOID,DWORD,LPDWORD, \ 
        LPOVERLAPPED))aSyscall[50].pCurrent) 
  
// some calls here 
  
  { "WriteFile",               (SYSCALL)WriteFile,               0 }, 
  
#define osWriteFile ((BOOL(WINAPI*)(HANDLE,LPCVOID,DWORD,LPDWORD, \ 
        LPOVERLAPPED))aSyscall[59].pCurrent) 
  
// last calls here 
  
}; /* End of the overrideable system calls */

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
unit lySQLite3CryptDB; 
  
// Implémentation d'une BD SQLite3 cryptée à la volée, pour Windows 32 bits, utilisant 
// (détournant) les systèmes de fichiers virtuels (VFS) de SQLite version 3.7.13 
// Yves Lemaire alias tourlourou 2011-2013 
// Utilisation libre, mais sans garantie, 
// sous réserve de conserver cet en-tête 
  
{$mode objfpc}{$H+} 
  
interface 
  
uses 
  Classes, SysUtils, Windows, lySQLite3DB, lySQLite3OSIntf; 
  
type 
  // prototype des fonctions de cryptage/décryptage à passer en CallBack 
  TCryptAlg = function(var Buffer: TByteArray; Size: integer; Position: int64; PassWord: string; Write: Boolean): Boolean; 
  
  // classe qui encapsule une BDD SQLite3 (version 3.7.17) cryptée à la volée 
  TlySQLiteCryptDB = class(TlySQLiteDB) 
  private 
    WinVfs: PSQLiteVFS; 
  public 
    constructor Create; overload; 
    destructor Destroy; override; 
    function Open(aDBName: TFileName): Boolean; override; 
    function Open(aDBName: TFileName; aCryptAlg: TCryptAlg; aPassWord: string): Boolean; overload; // passer nil ou EmptyStr si pas de cryptage 
  end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
implementation 
  
uses 
  lySQLite3Intf; 
  
type 
  // prototype des fonctions d'accès interne aux fichiers du VFS de Win32 
  TOSReadWrite = function(aFile: THandle; var aBuffer: TByteArray; aSize: integer; var aDone: integer; var aOLapd: OverLapped ): Boolean; stdcall; 
  
var 
  // nécessaires car visibles des fonctions d'accès fichiers ci-dessous 
  // attention : compatible exclusivement avec le pattern singleton 
  WinRead, WinWrite: TOSReadWrite; 
  lyCryptAlg: TCryptAlg; 
  lyPassWord: String; 
  MustCrypt: Boolean;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
constructor TlySQLiteCryptDB.Create; 
begin 
  inherited Create; 
  // initialisations liées au cryptage 
  MustCrypt:=False; 
  // récupération du VFS par défaut = Win32 
  WinVfs:=sqlite3_vfs_find(nil); // nil => renvoie VFS par défaut 
  if not Assigned(WinVfs) then raise Exception.Create('Erreur VFS par défaut renvoyé nil'); 
  if WinVfs^.Name<>Win32VFSName then raise Exception.Create('Erreur de nom de VFS ; réservé aux systèmes Win32, sauf CE'); 
  if WinVfs^.Version<VfsVersion then raise Exception.Create('Erreur de compatibilité de version de VFS'); 
  // détournement des accès système de lecture et écriture 
  WinRead:=TOSReadWrite(WinVfs^.GetSystemCall(WinVfs, 'ReadFile')); 
  if not Assigned(WinRead) then raise Exception.Create('Erreur récupération ReadFile'); 
  if WinVfs^.SetSystemCall(WinVfs, 'ReadFile', @lyCryptRead)<>SQLITE_OK then raise Exception.Create('Erreur d''enregistrement lyReadFile'); 
  WinWrite:=TOSReadWrite(WinVfs^.GetSystemCall(WinVfs, 'WriteFile')); 
  if not Assigned(WinWrite) then raise Exception.Create('Erreur récupération WriteFile'); 
  if WinVfs^.SetSystemCall(WinVfs, 'WriteFile', @lyCryptWrite)<>SQLITE_OK then raise Exception.Create('Erreur d''enregistrement lyWriteFile'); 
end;

1
2
3
4
5
6
destructor TlySQLiteCryptDB.Destroy; 
begin 
  inherited Destroy; 
  // restauration des appels système 
  if WinVfs^.SetSystemCall(WinVfs, nil, nil)<>SQLITE_OK then raise Exception.Create('Erreur de réenregistrement SysCalls'); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
function TlySQLiteCryptDB.Open(aDBName: TFileName): Boolean; 
begin 
  Result := Open(aDBName, nil, EmptyStr); 
end; 
  
function TlySQLiteCryptDB.Open(aDBName: TFileName; aCryptAlg: TCryptAlg; aPassWord: string): Boolean; 
begin 
  Result := inherited Open(aDBName); 
  lyCryptAlg := aCryptAlg; 
  lyPassWord := aPassWord; 
  MustCrypt  := Assigned(lyCryptAlg) and (lyPassWord>EmptyStr); 
end;

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
function lyCryptRead(aFile: Handle; var aBuffer: TByteArray; aSize: integer; var aDone: integer; var aOLapd: OverLapped ): Boolean; stdcall; 
var 
  Offset: int64; 
begin 
  Result:=WinRead(aFile, aBuffer, aSize, aDone, aOLapd); // on laisse faire WinVFS... 
  if Result and MustCrypt 
  then begin // on décrypte le Buffer 
    Offset := aOLapd.Offset + aOLapd.OffsetHigh shl 32 ; 
    if not lyCryptAlg(aBuffer, aDone, Offset, lyPassWord, False) 
    then aDone:=0; // SQLite renverra le Buffer vide et ShortRead alors que c'est un problème de décryptage... 
  end; 
end; 
  
function lyCryptWrite(aFile: integer; var aBuffer: TByteArray; aSize: integer; var aDone: integer; var aOLapd: OverLapped ): Boolean; stdcall; 
var 
  Offset: int64; 
  PCryptBuffer: PByteArray; 
begin 
  if not MustCrypt 
  then Result:=WinWrite(aFile, aBuffer, aSize, aDone, aOLapd) // on laisse faire WinVFS... 
  else begin // on crypte le Buffer 
    PCryptBuffer:=GetMem(aSize); 
    Move(aBuffer, PCryptBuffer^, aSize); 
    Offset := aOLapd.Offset + aOLapd.OffsetHigh shl 32 ; 
    if not lyCryptAlg(PCryptBuffer^, aSize, Offset, lyPassWord, True) 
    then aDone:=-1 // indiquera une erreur d'écriture alors que c'est un problème de cryptage...  
    else Result:=WinWrite(aFile, PCryptBuffer^, aSize, aDone, aOLapd); 
    FreeMem(PCryptBuffer); 
  end; 
end;

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
unit Unit1; 
  
{$mode objfpc}{$H+} 
  
interface 
  
uses 
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 
  Grids, lySqlite3Intf, lySQLite3Param, lySqlite3DB,  
  lySQLite3OSIntf, lySQLite3CryptDB;  
  
type 
  
  { TForm1 } 
  
  TForm1 = class(TForm) 
    Button1: Tbutton; 
    StringGrid1: TStringGrid;  
    Memo1: Tmemo; 
    procedure MemoLog(aSender: TObject; aText: string); 
    procedure Button1Click(Sender: TObject); 
  private 
    { private declarations } 
  public 
    { public declarations } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
function TestCrypt(var aBuffer: TByteArray; aSize: integer; aPosition: int64; aPassWord: string; aWrite: Boolean): Boolean; 
var 
  i, j, l: integer; 
  srce, pass: Byte; 
begin 
  l:=Length(aPassWord); 
  for i:=1 to aSize 
  do begin 
    srce:=aBuffer[i-1]; 
    j := (aPosition + i)  mod l ; 
    if j=0 then j:=l; 
    pass:=Ord(aPassWord[j]); 
    if (srce>0) and (srce<>pass) 
    then aBuffer[i-1] := srce xor pass ; 
  end; 
  Result:=True;  
end;

1
2
3
4
5
6
{ TForm1 } 
  
procedure TForm1.MemoLog(aSender: TObject; aText: string); 
begin 
  Memo1.Lines.Add('        >'+aText); 
end;

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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
procedure TForm1.Button1Click(Sender: Tobject); 
  
const 
  Path_Bdd = 'c:\userfiles\test.txt' ; // à personnaliser 
  Flush    = 'OFF' ; // 'ON' pour activer le Flush à chaque écriture 
  NbTests  = 5000 ; // nombre d'itérations pour le test de vitesse 
  
var 
  MyBd: TlySQLiteCryptDB; 
  MyDb: TlySQLiteDB; 
  SQList: TStringList; 
  MyDbName, S: string; 
  i, intervalle: integer; 
  dtBegin, dtEnd, dtElapsed: TDateTime;      
  
begin 
  Memo1.Clear; 
  intervalle := NbTests div 10; 
  MyBd:=TlySQLiteCryptDB.Create; 
  MyBd.AutoLog:=False; 
  MyBd.OnLog:=@MemoLog; 
  MyBd.LogRequests:=True; 
  Memo1.Lines.Add('***** connexion de TlySQLiteCryptDB à une base cryptée *****'); 
  MyDbName:=ChangeFileExt(Path_Bdd, '.cry'); 
  DeleteFile(MyDbName); 
  // 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 not MyBd.Open(MyDbName, @TestCrypt, 'test_password') 
  then Memo1.Lines.Add(MyBD.LastErrorMsg); 
  Memo1.Lines.Add('***** création de la table, utilisation de Execute(TStrings) *****'); 
  SQList:=TStringList.Create; 
  SQList.Add('CREATE TABLE employes ( id INTEGER PRIMARY KEY , nom TEXT , age INTEGER )'); 
  SQList.Add('INSERT INTO employes ( nom , age ) VALUES ( "toto" , 50 )'); 
  SQList.Add('INSERT INTO employes ( nom , age ) VALUES ( "tata" , 25 )'); 
  MyBd.Execute(SQList); 
  SQList.Free; 
  Memo1.Lines.Add('***** appel de ToStringGrid *****'); 
  MyBd.ToStringGrid(StringGrid1, 'SELECT * FROM employes'); 
  StringGrid1.Refresh; 
  // tests de vitesse 
  Memo1.Lines.Add('***** test de célérité de TlySQLiteCryptDB avec une base cryptée *****'); 
  MyBd.Execute('DELETE FROM employes'); 
  MyBd.Execute('PRAGMA synchronous = '+Flush); 
  MyBd.OnLog:=nil; 
  dtBegin:=Now; 
  for i:=1 to NbTests 
  do begin 
    S:=IntToStr(i); 
    MyBd.Execute('INSERT INTO employes ( nom , age ) VALUES ( "tutu" , '+S+' )'); 
    if i mod intervalle = 0 
    then Memo1.Lines.Add('écriture '+S+'/'+IntToStr(NbTests)); 
  end; 
  Memo1.Lines.Add(TimeToStr(Now-dtBegin)); 
  for i:=1 to NbTests 
  do begin 
   MyBd.ToString(S, 'SELECT rowid FROM employes WHERE age = '+IntToStr(i)); 
   if i mod intervalle = 0 
   then Memo1.Lines.Add('lecture '+S+'/'+IntToStr(NbTests)); 
  end; 
  dtEnd:=Now; 
  dtElapsed:=dtEnd-dtBegin; 
  Memo1.Lines.Add('Total : '+TimeToStr(dtElapsed)); 
  Memo1.Lines.Add('***** test de célérité de TlySQLiteCryptDB avec une base non cryptée *****'); 
  MyBd.OnLog:=@MemoLog; 
  MyBd.LogRequests:=True; 
  MyDbName:=ChangeFileExt(Path_Bdd, '.clr'); 
  DeleteFile(MyDbName); 
  MyBd.Open(MyDbName); 
  MyBd.Execute('PRAGMA synchronous = '+Flush); 
  MyBd.Execute('CREATE TABLE employes ( id INTEGER PRIMARY KEY , nom TEXT , age INTEGER )'); 
  MyBd.OnLog:=nil; 
  dtBegin:=Now; 
  for i:=1 to NbTests 
  do begin 
    S:=IntToStr(i); 
    MyBd.Execute('INSERT INTO employes ( nom , age ) VALUES ( "tutu" , '+S+' )'); 
    if i mod intervalle = 0 
    then Memo1.Lines.Add('écriture '+S+'/'+IntToStr(NbTests)); 
  end; 
  Memo1.Lines.Add(TimeToStr(Now-dtBegin)); 
  for i:=1 to NbTests 
  do begin 
   MyBd.ToString(S, 'SELECT rowid FROM employes WHERE age = '+IntToStr(i)); 
   if i mod intervalle = 0 
   then Memo1.Lines.Add('lecture '+S+'/'+IntToStr(NbTests)); 
  end; 
  dtEnd:=Now; 
  dtElapsed:=dtEnd-dtBegin; 
  Memo1.Lines.Add('Total : '+TimeToStr(dtElapsed)); 
  MyBd.Free; 
  Memo1.Lines.Add('***** test de célérité de TlySQLiteDB avec une base en clair *****'); 
  MyDb:=TlySQLiteDB.Create; 
  MyDb.OnLog:=@MemoLog; 
  MyDb.LogRequests:=True; 
  MyDbName:=ChangeFileExt(Path_Bdd, '.bdd'); 
  DeleteFile(MyDbName); 
  MyDb.Open(MyDbName); 
  MyDb.Execute('PRAGMA synchronous = '+Flush); 
  MyDb.Execute('CREATE TABLE employes ( id INTEGER PRIMARY KEY , nom TEXT , age INTEGER )'); 
  MyDb.OnLog:=nil; 
  dtBegin:=Now; 
  for i:=1 to NbTests 
  do begin 
    S:=IntToStr(i); 
    MyDb.Execute('INSERT INTO employes ( nom , age ) VALUES ( "tutu" , '+S+' )'); 
    if i mod intervalle = 0 
    then Memo1.Lines.Add('écriture '+S+'/'+IntToStr(NbTests)); 
  end; 
  Memo1.Lines.Add(TimeToStr(Now-dtBegin)); 
  for i:=1 to NbTests 
  do begin 
   MyDb.ToString(S, 'SELECT rowid FROM employes WHERE age = '+IntToStr(i)); 
   if i mod intervalle = 0 
   then Memo1.Lines.Add('lecture '+S+'/'+IntToStr(NbTests)); 
  end; 
  dtEnd:=Now; 
  dtElapsed:=dtEnd-dtBegin; 
  Memo1.Lines.Add('Total : '+TimeToStr(dtElapsed)); 
  MyDb.OnLog:=@MemoLog; 
  MyDb.LogRequests:=True; 
  MyDb.Free;   
end;   
  
end.