Tutoriel pour apprendre comment ajouter à la bibliothèque SQLite un objet de type Table

Par tourlourou

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
unit lySQLiteIntf;  
  
interface 
  
uses 
  SysUtils; 
  
const 
  // liées à ce wrapper et la version minimale de la dll 
  DllName    = 'sqlite3.dll' ;  // Library Name 
  sMinVersion  = '3.7.17'; 
  MinVersion   = 3007017; 
  IO_Version   = 3; 
  VfsVersion   = 3; 
  Win32VFSName = 'win32'; 
  WinFileStructLength = 72;

1
2
3
4
5
6
7
  // types de champs 
  SQLITE_INTEGER = 1; 
  SQLITE_FLOAT   = 2; 
  SQLITE_TEXT    = 3; 
  SQLITE3_TEXT   = 3; 
  SQLITE_BLOB    = 4; 
  SQLITE_NULL    = 5;

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
type 
  PStatement  = Pointer; // sur requête préparée (précompilée)  
  
// préparation d'une requête  
// aSQLLength (#0 inclus) : SQL lu jusqu'au 1° #0 ou cette longueur ; -1 => jusqu'au premier #0 
// aStatement : vaut nil si erreur ; doit être finalisé (méthode utilisable sans erreur sur nil) 
// aTail pointe sur la suite non lue du SQL dans aSQL   
function sqlite3_prepare_v2(aDB: PSQLiteDB; aSQL: PChar; aSQLLength: integer; var aStatement: PStatement; var aTail: PChar): integer; cdecl; external DllName; 
  
// libération des ressources en fin d'utilisation  
// ne jamais utiliser un Statement finalisé sous peine de risquer des fuites mémoires ou corruptions 
function sqlite3_finalize(aStatement: PStatement): integer; cdecl; external DllName; 
  
// exécution pas à pas (ligne par ligne) 
// retourne SQLITE_ROW à chaque ligne de résultat disponible 
// et SQLITE_DONE en fin d'exécution ; sinon, code d'erreur. 
// ne pas réutiliser un statement après SQLITE_DONE sans faire de sqlite3_reset 
function sqlite3_step(aStatement: PStatement): integer; cdecl; external DllName; 
  
// RAZ statement pour une nouvelle exécution (ne sera pas exploité pour ToTable) 
// attention : ne RAZ pas les paramètres (utiliser sqlite3_clear_bindings, non wrappé) 
function sqlite3_reset(aStatement: PStatement): integer; cdecl; external DllName; 
  
// nb de colonnes du résultat (0 pour un UPDATE, par ex.) 
function sqlite3_column_count(aStatement: PStatement): integer; cdecl; external DllName; 
  
// même chose, mais après chaque SQLITE_ROW ; intérêt ? 
function sqlite3_data_count(aStatement: PStatement): integer; cdecl; external DllName; 
  
// récupération des métadonnées 
// la dll a été compilée avec l'option SQLITE_ENABLE_COLUMN_METADATA 
// qui permet notamment de retrouver des données de colonnes lors d'un SELECT 
  
// aDBName pê NULL => recherche parmi toutes les bases attachées 
// aPrimaryKey True if column part of PK 
function sqlite3_table_column_metadata(aDB: PSQLiteDB; aDBName, aTableName, aColumnName: PChar; 
   var aDataType, aCollSeq: PChar; var aNotNull, aPrimaryKey, aAutoInc: LongBool): integer; cdecl; external DllName; 
  
// noms retournés dé-aliasés et valides jusqu'à Finalize, Step ou demandés en WideChar (interface non faite ici) 
function sqlite3_column_database_name(aStatement: PStatement; aCol: integer): PChar; cdecl; external DllName; 
function sqlite3_column_table_name(aStatement: PStatement; aCol: integer): PChar; cdecl; external DllName; 
// origin_name = field name 
function sqlite3_column_origin_name(aStatement: PStatement; aCol: integer): PChar; cdecl; external DllName; 
// nom de l'alias quand il y a un AS dans un SELECT (indéfini sinon) 
function sqlite3_column_name(aStatement: PStatement; aCol: integer): PChar; cdecl; external DllName; 
// nom du type lors du CREATE 
function sqlite3_column_decltype(aStatement: PStatement; aCol: integer): PChar; cdecl; external DllName; 
// avant cast éventuel 
function sqlite3_column_type(aStatement: PStatement; aCol: integer): integer; cdecl; external DllName; 
  
// récupération des valeurs elles-mêmes 
// nb d'octets du champ ; 0 si NULL ; n si BLOB ou UTF-8 (#0 terminal exclu) ; n après conversion numérique -> UTF-8 
function sqlite3_column_bytes(aStatement: PStatement; aCol: integer): integer; cdecl; external DllName; 
function sqlite3_column_int(aStatement: PStatement; aCol: integer): integer; cdecl; external DllName; 
function sqlite3_column_int64(aStatement: PStatement; aCol: integer): Int64; cdecl; external DllName; 
function sqlite3_column_double(aStatement: PStatement; aCol: integer): Double; cdecl; external DllName; 
function sqlite3_column_text(aStatement: PStatement; aCol: integer): PChar; cdecl; external DllName; 
function sqlite3_column_blob(aStatement: PStatement; aCol: integer): TBytes; cdecl; external DllName;   
  
end;

1
2
3
4
5
6
7
8
9
10
implementation 
  
initialization 
  if sqlite3_libversion_number < MinVersion   
  then raise Exception.Create('Cryptage prévu seulement pour SQLite '+sMinVersion+' 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
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
  // pré-declaration 
  TlySQLiteTable = class;   
  
  TlyField = class 
  private 
    FName: string; 
    FText: string; 
    FNull: Boolean; 
    bText: Boolean; 
    FType: TlyFieldType; 
      // nouvelles déclarations 
      FStream: TMemoryStream; 
      FTable: TlySQLiteTable; 
      FRow, FCol: integer; 
      FOnValueChange: TValidateEntryEvent; 
  protected 
    procedure SetNull(aValue: Boolean); 
    procedure SetText(aValue: string); 
    procedure SetSQL(aValue: string); 
    function  GetSQL: string; 
    procedure SetInt(aValue: int64); 
    function  GetInt: int64; 
    procedure SetFloat(aValue: Double); 
    function  GetFloat: Double; 
    procedure SetBool(aValue: Boolean); 
    function  GetBool: Boolean; 
    procedure SetTime(aValue: TDateTime); 
    function  GetTime: TDateTime; 
      // nouvelles déclarations 
      function  GetCanUpdateDB: Boolean; 
      function  GetIsBlob: Boolean; 
  public 
    constructor Create; overload; 
    constructor Create(aName: string); overload; 
    constructor Create(aName: string; aType: TlyFieldType); overload; 
    destructor  Destroy; override; 
    procedure Clear; 
      // nouvelles déclarations 
      function  BlobToStream(var aStream: TStream): Boolean; 
      procedure StreamToBlob(aStream: TStream); 
    property Name: string read FName; // affectable seulement par le constructeur 
      property Row: integer read FRow; 
      property Col: integer read FCol; 
      property Table: TlySQLiteTable read FTable; 
    property FieldType: TlyFieldType read FType; // affectable seulement par le constructeur ou le type de la valeur affectée 
    property IsText: Boolean read bText; 
      property IsBlob: Boolean read getIsBlob; 
    property IsNull: Boolean read FNull write SetNull; 
      property CanUpdateDB: Boolean read getCanUpdateDB; 
    property AsSQL: string read GetSQL write SetSQL; // par défaut UTF-8 pour SQLite 3.7.13 ; quoté si nécessaire (texte) 
    property AsText: string read FText write SetText; // valeur brute de la chaîne, sans quotes éventuelles 
    property AsInteger: int64 read GetInt write SetInt; // stockage interne dans SQLite sous forme d'entier de 1 à 8 octets 
    property AsFloat: Double read GetFloat write SetFloat; // c'est le format de stockage interne des réels dans SQLite 
    property AsBoolean: Boolean read GetBool write SetBool; // stockage interne en tant qu'entier : False=0 et True=1 
    property AsDateTime: TDateTime read GetTime write SetTime; // pas de stockage par défaut dans SQLite : traité comme réel

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
// ne peut servir qu'à rendre NULL : l'inverse se fait en affectant qqch 
procedure TlyField.SetNull(aValue: Boolean); 
begin 
  if aValue 
  then begin 
    SetText('NULL'); // appellera la CallBack de mise à jour 
    bText:=False; //  car mot réservé 
    FNull:=True; 
  end; 
end; 
  
procedure TlyField.Clear;  
begin 
  SetNull(True); 
  FType:=ftUnknown; 
  FStream.Clear;  
  // on préserve la synchro FCol et FRow d'un champ d'une table 
  if not Assigned(FTable) 
  then begin 
    FCol:=-1; 
    FRow:=-1; 
  end; 
end; 
  
constructor TlyField.Create; 
begin 
  inherited; 
  FStream:=TMemoryStream.Create; 
  FName:=''; 
  Clear; 
end; 
  
constructor TlyField.Create(aName: string); 
begin 
  Create; 
  FName:=aName; 
end; 
  
constructor TlyField.Create(aName: string; aType: TlyFieldType); 
begin 
  Create(aName); 
  FType:=aType; 
end; 
  
destructor TlyField.Destroy; 
begin 
  FreeAndNil(FStream); 
  inherited; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
  // Métadonnées d'une colonne 
  TColMetaData = class   
    Number: integer; // zero based 
    DBName, 
    TableName, 
    OriginName, 
    FullName, 
    AliasName: string; 
    IsView, 
    IsRowid, 
    Visible: Boolean; 
    Affinity: TlyFieldAffinity; 
    Sorting: TlyCollateSequence; 
    NotNull, 
    PrimaryKey, 
    AutoInc: Boolean; 
    RowidCol: integer; 
    FieldType: TlyFieldType; 
  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
  // Callback d'une méthode de lySQLiteDB exécutant une requête d'Update d'une valeur modifiée dans la table 
  TUpdateFromTable = function(aTable: TlySQLiteTable; aSQL: string): Boolean of object;  
  
  // table remplissable par une requête préparée 
  TlySQLiteTable = class 
  private 
    FUpdateIfModified, FBiDiUpdate: Boolean; 
    FRowCount, FColCount, FCurrentField, FRowShift: integer; 
    FColData, FFields: TObjectList; 
    FDataBase: TObject; 
    FConnexion: Pointer; 
    FUpdateFromTable: TUpdateFromTable; 
    Subset, GridToCol, ColToGrid: array of integer; 
    FGrid: TStringGrid; 
  protected 
    procedure setUpdateIfModified(aValue: Boolean); 
    function  getSubsetCount: integer; 
    procedure setColCount(aValue: integer); 
    function  getColMetaData(aIndex: integer): TColMetaData; 
    function  getColByName(aName: string): integer; 
    function  getFieldByIndex(aCol, aRow: integer): TlyField; 
    function  getFieldByName(aName: string; aRow: integer): TlyField; 
    function  getSubsetFieldByIndex(aCol, aIndex: integer): TlyField; 
    function  getSubsetFieldByName(aName: string; aIndex: integer): TlyField; 
    function  SameLevelColName(aFieldName: string; aColIndex: integer): string; 
    function  UpdateDB(aCol, aRow: Integer; aValue: string): Boolean; 
    procedure OnCellChange(sender: TObject; aCol, aRow: Integer; const OldValue: string; var NewValue: string); 
    procedure OnFieldChange(sender: TObject; aCol, aRow: Integer; const OldValue: string; var NewValue: string); 
  public 
    constructor Create; 
    destructor  Destroy; override; 
    procedure   Clear; 
    // méthodes de peuplement de l'ensemble de données 
    procedure AddCol(var aColMetaData: TColMetaData); 
    procedure AddField(var aField: TlyField); 
    procedure EndRow; 
    procedure EndFilling(aDataBase: TObject = nil; aConnexion: Pointer = nil; aUpdateFromTable: TUpdateFromTable = nil; aUpdateDBOnChange: Boolean = False); 
    // méthodes d'exploitation des données 
    procedure ToStringGrid(aGrid: TStringGrid; aBiDiUpdate: Boolean; aWithFieldName: Boolean = True; aWithRowNumber: Boolean = True ); 
    function  SaveToCSV(aName: TFileName; EmptyNull: Boolean = False; WithoutBlobs: Boolean = True): Boolean; 
    property ColCount: integer read FColCount write setColCount; 
    property RowCount: integer read FRowCount; 
    property SubsetCount: integer read getSubsetCount; 
    property DataBase: TObject read FDataBase; 
    property Connexion: Pointer read FConnexion; 
    property UpdateIfModified: Boolean read FUpdateIfModified write setUpdateIfModified; 
    property ColByName[aName: string]: integer read getColByName; 
    // les objets renvoyés sont pour consultation seulement : il ne faut pas les libérer ! 
    property ColMetaData[Index: integer]: TColMetaData read getColMetaData; 
    property Field[aCol, aRow: integer]: TlyField read getFieldByIndex; 
    property FieldByName[aName: string; aRow: integer]: TlyField read getFieldByName; 
    // sélection/filtrage des données selon une valeur 
    function Locate(aValue: string; aCol: integer): Boolean; overload; 
    function Locate(aValue, aFieldName: string): Boolean; overload; 
    // parcours de la sélection après un Locate 
    property SubsetFieldByName[aName: string; aIndex: integer]: TlyField read getSubsetFieldByName; 
  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
procedure TlySQLiteTable.Clear; 
begin 
  FreeAndNil(FFields); 
  FreeAndNil(FColData); 
  SetLength(Subset, 0); 
  SetLength(GridToCol, 0); 
  SetLength(ColToGrid, 0); 
  FRowCount:=0; 
  FColCount:=0; 
  FCurrentField:=0; 
  FDataBase:=nil; 
  FConnexion:=nil; 
  // paramétrages par défaut 
  FUpdateIfModified:=False; 
  // préparation des listes 
  // propriétaires des objets 
  FFields:=TObjectList.Create(True); 
  FColData:=TObjectList.Create(True); 
 end;    
  
constructor TlySQLiteTable.Create; 
begin 
  inherited; 
  Clear; 
end; 
  
destructor TlySQLiteTable.Destroy; 
begin 
  // libèration des champs et métadonnées 
  FFields.Free; 
  FColData.Free; 
  SetLength(Subset, 0); 
  SetLength(GridToCol, 0); 
  SetLength(ColToGrid, 0); 
  inherited; 
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
procedure TlySQLiteTable.AddCol(var aColMetaData: TColMetaData); 
begin 
  // métadonnées acceptées seulement à la 1° ligne 
  if FRowCount>0 
  then Exception.Create('Table.AddCol impossible after EndRow'); 
  // envoi des colonnes dans l'ordre ? 
  if aColMetaData.Number<>FColData.Count 
  then Exception.Create('Table.AddCol column index mismatch'); 
  // vérification qu'on n'envoie pas trop de colonnes 
  if FColData.Count<ColCount 
  then begin 
    FColData.Add(aColMetaData); // ajout des données 
    aColMetaData:=nil; // la table devient propriétaire des données 
  end 
  else Exception.Create('Table.AddCol exceeds ColCount'); 
end; 
  
procedure TlySQLiteTable.AddField(var aField: TlyField); 
begin 
  if FCurrentField<ColCount 
  then begin 
    if aField.Name=ColMetaData[FCurrentField].FullName // setter Name à FullName si nil ? 
    then begin 
      aField.FTable:=self; 
      aField.FCol:=FCurrentField; 
      aField.FRow:=FRowCount; 
      FFields.Add(aField); 
      aField:=nil; // la table gardera la propriété du champ 
      Inc(FCurrentField); 
    end 
    else Exception.Create('Col/Field names mismatch'); 
  end 
  else Exception.Create('Table.AddField exceeds ColCount'); 
end; 
  
procedure TlySQLiteTable.EndRow; 
begin 
  // vérification qu'il est bien appelé au bon moment 
  if (FCurrentField=ColCount) 
  and (FColData.Count=ColCount) 
  then begin 
    Inc(FRowCount); 
    FCurrentField:=0; 
  end 
  else Exception.Create('Table Col/Field Number <> ColCount'); 
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
procedure TlySQLiteTable.EndFilling(aDataBase: TObject = nil; aConnexion: Pointer = nil; aUpdateFromTable: TUpdateFromTable = nil; aUpdateDBOnChange: Boolean = False); 
var 
  i, j: integer; 
  ColData_1, ColData_2: TColMetaData; 
  TableName_1, TableName_2: string; 
begin 
  if FCurrentField=0 // cad EndRow avant => RowCount et DataCol corrects 
  then begin 
    FDataBase:=aDataBase; 
    FConnexion:=aConnexion; 
    FUpdateFromTable:=aUpdateFromTable; 
    UpdateIfModified:=aUpdateDBOnChange; 
    // on prépare toujours pour Update : peut être modifié ensuite 
    // mais ne sera effectif que pour chaque nouvelle modification 
    for i:=0 to FColCount-1 
    do begin 
      ColData_1:=ColMetaData[i]; 
      if ColData_1.IsRowid 
      then begin 
        TableName_1:=ColData_1.DBName+'.'+ColData_1.TableName; 
        for j:=0 to FColCount-1 
        do begin 
          ColData_2:=ColMetaData[j]; 
          TableName_2:=ColData_2.DBName+'.'+ColData_2.TableName; 
          if (TableName_2=TableName_1) 
          and not ColData_2.IsRowid // restera à -1 car non modifiable (même si possible dans SQLite) 
          then ColData_2.RowidCol:=i; 
        end; 
      end; 
    end; 
  end 
  else Exception.Create('Table not correctly filled (missing EndRow)'); 
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
procedure TlySQLiteTable.setUpdateIfModified(aValue: Boolean); 
var 
  i: integer; 
begin 
  if aValue and not FUpdateIfModified 
  // and (FColData.Count>0) and Assigned(ColMetaData[0].DB) // ces 2 conditions ne sont pas forcément nécessaires 
  then begin 
    for i:=0 to FFields.Count-1 
    do TlyField(FFields[i]).FOnValueChange:=@OnFieldChange; 
  end; 
  FUpdateIfModified:=aValue; 
end; 
  
function TlySQLiteTable.getSubsetCount: integer; 
begin 
  Result:=Length(Subset); 
end; 
  
procedure TlySQLiteTable.setColCount(aValue: integer); 
begin 
  // pour éviter des fuites mémoire ou des erreurs d'indexation 
  // si l'utilisateur voulait modifier le nombre de colonnes 
  // d'une table. S'il en a besoin, faire un Clear d'abord 
  if FColCount=0 
  then FColCount:=aValue 
  else Exception.Create('Table.ColCount already set'); 
end;       
  
function TlySQLiteTable.getColMetaData(aIndex: integer): TColMetaData; 
begin 
  try 
    Result:=TColMetaData(FColData[aIndex]); 
  except 
    Result:=nil; 
  end; 
end;     
  
function TlySQLiteTable.SameLevelColName(aFieldName: string; aColIndex: integer): string; 
var 
  Qualifiers: integer; 
  tsl: TStringList; 
  ColData: TColMetaData; 
begin 
  Result:=EmptyStr; 
  tsl:=TStringList.Create; 
  tsl.Delimiter:='.'; 
  tsl.DelimitedText:=aFieldName; 
  Qualifiers:=tsl.Count; 
  tsl.Free; 
  if not Qualifiers in [1..3] then Exit; 
  ColData:=ColMetaData[aColIndex]; 
  case Qualifiers of 
   1: Result:=ColData.AliasName; 
   2: Result:=ColData.TableName+'.'+ColData.AliasName; 
   3: Result:=ColData.DBName+'.'+ColData.TableName+'.'+ColData.AliasName; 
  end; 
end; 
  
function TlySQLiteTable.getColByName(aName: string): integer; 
var 
  i: integer; 
  FieldName: string; 
begin 
  Result:=-1; 
  for i:=0 to FColCount-1 
  do begin 
    FieldName:=SameLevelColName(aName, i); 
    if FieldName=aName 
    then begin 
      Result:=i; 
      Break; // renvoie donc le premier nom qui correspond 
    end; 
  end; 
end; 
  
function TlySQLiteTable.getFieldByIndex(aCol, aRow: integer): TlyField; 
var 
  i: integer; 
begin 
  if (aCol<0) or (aCol>FColCount-1) or (aRow<0) or (aRow>FRowCount-1) 
  then Result:=nil 
  else begin 
    i:=FColCount*aRow+aCol; 
    Result:=TlyField(FFields[i]); 
  end; 
end; 
  
function TlySQLiteTable.getFieldByName(aName: string; aRow: integer): TlyField; 
var 
  i: integer; 
begin 
  i:=getColByName(aName); 
  Result:=getFieldByIndex(i, aRow); 
end; 
  
function  TlySQLiteTable.getSubsetFieldByIndex(aCol, aIndex: integer): TlyField; 
begin 
  if (aCol<0) or (aCol>FColCount-1) or (aIndex<0) or (aIndex>SubsetCount-1) 
  then Result:=nil 
  else Result:=TlyField(FFields[Subset[aIndex]]); 
end; 
  
function  TlySQLiteTable.getSubsetFieldByName(aName: string; aIndex: integer): TlyField; 
var 
  i: integer; 
begin 
  i:=getColByName(aName); 
  Result:=getSubsetFieldByIndex(i, aIndex); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
function TlySQLiteDB.ToTable(aTable: TlySQLiteTable; aSQL: string; aUpdateDBIfTableChange: Boolean): Boolean;  
  
procedure TlySQLiteTable.ToStringGrid(aGrid: TStringGrid; aBiDiUpdate: Boolean; aWithFieldName: Boolean = True; aWithRowNumber: Boolean = True );  
  
function TlySQLiteTable.Locate(aValue, aFieldName: string): Boolean; 
  
//.. 
  
if DB.ToTable( MaTable, 'SELECT * FROM employes', False) then begin 
  MaTable.ToStringGrid( StringGrid1, False); 
  if MaTable.Locate( 'tourlourou', 'nom') and ( MaTable.SubsetCount = 1 ) then  
    ShowMessage( 'tourlourou gagne ' + MaTable.SubsetFieldByName[ 'salaire', 0].AsText ); 
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
function TlySQLiteDB.ToTable(aTable: TlySQLiteTable; aSQL: string; aUpdateDBIfTableChange: Boolean): Boolean; 
var 
  Requete, DB_Name, TableName, OriginName, FullName, AliasName, RowidAlias, Value, PrevTable, AliasQuest, S: string; 
  ErrCode, Row, ColCount, Col, ColType, iSize: integer; 
  View, NotNull, PrimaryKey, AutoInc: LongBool; 
  Error, DataType, CollSeq, Tail2: PChar; 
  Sorting: TlyCollateSequence; 
  Affinity: TlyFieldAffinity; 
  AliasStatement: PStatement; 
  ColMetaData: TColMetaData; 
  Tail: PChar = nil; 
  Blob: TBytes; 
  tms: TMemoryStream; 
begin 
  if aTable is TlySQLiteTable 
  then begin 
    // initialisations diverses 
    Result:=False; 
    aTable.Clear; // efface le paramétrage de UpdateIfModified 
    Error:=nil; 
    FreeAndNil(FField); 
    PrevTable:=EmptyStr; 
  
    if Assigned(FStatement) 
    then begin 
      if sqlite3_finalize(FStatement)=SQLITE_OK // libère mémoire requête précompilée 
      then FStatement:=nil; 
    end; 
  
    // préparation de la requête 
    if aSQL>UseParamSQL 
    then Requete:=aSQL 
    else Requete:=FParamSQL.Request; 
  
    // précompilation 
    ErrCode:=sqlite3_prepare_v2(DB, PChar(Requete), Length(Requete)+1, FStatement, Tail); 
  
    if ErrCode=SQLITE_OK 
    then Row:=0 
    else begin // fin si erreur (dans ce cas, FStatement = nil => pas besoin de Finalize) 
      FLastErrorCode:=ErrCode; 
      Error:=sqlite3_errmsg; 
      FLastErrorMsg:=StrPas(Error); 
      DoLog('Error : '+FLastErrorMsg+#10#13+' while preparing ToTable statement : '+Requete); 
      Exit; 
    end; 
  
    //---------------------------------------- 
    // exécution de la requête ligne par ligne 
    //---------------------------------------- 
    ErrCode:=sqlite3_step(FStatement); 
    while ErrCode=SQLITE_ROW do // nouvelle ligne de résultat prête 
    begin 
      //-------------------------------------------------------- 
      // on initialise le nombre de colonnes à la première ligne 
      //-------------------------------------------------------- 
      if Row=0 then 
      begin 
        // nombre de colonnes du DataSet résultat 
        ColCount:=sqlite3_column_count(FStatement); 
        // fixer la largeur de la table 
        aTable.ColCount:=ColCount; 
      end; 
  
      //-------------------------------------------------- 
      // déclenchement événement (CallBack) nouvelle ligne 
      //-------------------------------------------------- 
      if Assigned(OnNewRow) then OnNewRow(self, ColCount); 
  
      //-------------------------------------------- 
      // on récupère les données colonne par colonne 
      //-------------------------------------------- 
      for Col:=0 to ColCount-1 do 
      begin 
  
        //------------------------------------------- 
        // récupération des métadonnées de la colonne 
        //------------------------------------------- 
        if Row=0 then 
        begin 
          // par interrogation de la BDD à la première ligne 
          DB_Name    := StrPas( sqlite3_column_database_name( FStatement, Col) ); // nom symbolique de la base 
          TableName  := StrPas( sqlite3_column_table_name(    FStatement, Col) ); // nom de la table 
          OriginName := StrPas( sqlite3_column_origin_name(   FStatement, Col) ); // nom d'origine du champ 
          FullName   := DB_Name + '.' + TableName + '.' + OriginName ; 
          AliasName  := StrPas( sqlite3_column_name(          FStatement, Col) ); // nom du champ dans la requête (alias éventuel) 
          // une erreur est retournée si la table concernée est une vue 
          ErrCode    := sqlite3_table_column_metadata( DB, PChar(DB_Name), PChar(TableName), PChar(OriginName), 
                                                        DataType, CollSeq, NotNull, PrimaryKey, AutoInc); 
          // on va traiter chaque erreur comme si elle était renvoyée par une vue, 
          // mais ce n'est pê pas le cas... cependant, prudence => ReadOnly ! 
          View := ( ErrCode <> SQLITE_OK ); 
          if View 
          then begin 
            Affinity := faUnknown; 
            Sorting  := csUnknown; 
          end 
          else begin 
            // traduction ColumnAffinity 
            Affinity := faUnknown; 
            // If the declared type for a column contains the string "BLOB" 
            // or if no type is specified then the column has affinity NONE. 
            if (DataType = 'BLOB')   // devrait être NONE, mais BLOB observé... 
            or (DataType = 'NONE')   then Affinity := faBlob; 
            if  DataType = 'TEXT'    then Affinity := faText; 
            if  DataType = 'INTEGER' then Affinity := faInteger; 
            if  DataType = 'REAL'    then Affinity := faReal; 
            if  DataType = 'NUMERIC' then Affinity := faNumeric; 
            // traduction CollateSequence 
            Sorting := csUserDefined; 
            if CollSeq = 'BINARY' then Sorting := csBinary; 
            if CollSeq = 'NOCASE' then Sorting := csNoCase; 
            if CollSeq = 'RTRIM'  then Sorting := csRTrim; 
          end; 
  
          // recherche de l'Alias du Rowid 
          S := DB_Name + '.' + TableName; 
          if S <> PrevTable // économie si monotable ! 
          then begin 
            AliasQuest:='SELECT rowid FROM '+S; 
            iSize:=Length(AliasQuest)+1; 
            if sqlite3_prepare_v2(DB, PChar(AliasQuest), iSize, AliasStatement, Tail2) = SQLITE_OK 
            then begin 
              RowidAlias := StrPas( sqlite3_column_name( AliasStatement, Col) ) ; 
              sqlite3_finalize(AliasStatement); 
            end 
            else RowidAlias := EmptyStr; 
            PrevTable:=S; 
          end; 
  
          // ajout des métadonnées 
          ColMetaData:=TColMetaData.Create; 
          ColMetaData.Affinity   := Affinity; 
          ColMetaData.AliasName  := AliasName; 
          ColMetaData.AutoInc    := AutoInc; 
//          ColMetaData.DB         := DB; 
          ColMetaData.DBName     := DB_Name; 
          ColMetaData.FieldType  := ftUnknown; 
          ColMetaData.FullName   := FullName; 
          ColMetaData.IsView     := View; 
          ColMetaData.IsRowid    := ( AliasName = RowidAlias ) ; 
          ColMetaData.NotNull    := NotNull; 
          ColMetaData.Number     := Col; 
          ColMetaData.OriginName := OriginName; 
          ColMetaData.PrimaryKey := PrimaryKey; 
          ColMetaData.RowidCol   := -1; 
          ColMetaData.Sorting    := Sorting; 
          ColMetaData.TableName  := TableName; 
          ColMetaData.Visible    := True; 
          try 
            //---------------------- 
            // on renseigne la table 
            //---------------------- 
            aTable.AddCol(ColMetaData); 
          except 
            on E: Exception 
            do begin 
              DoLog('Error : '+E.Message+#10#13 
                    +' with ToTable statement : '+Requete); 
              FreeAndNil(ColMetaData); // car aTable pas devenue propriétaire de l'objet 
              if sqlite3_finalize(FStatement)=SQLITE_OK 
              then FStatement:=nil;  // sinon, sera repassé dans Finalze au Destroy 
              Exit; 
            end; 
          end; // try 
        end 
        else begin 
          // auprès de la table pour les lignes suivantes 
          FullName  := aTable.ColMetaData[Col].FullName;  // ou OriginName pour le Field.Create ?????????? 
          AliasName := aTable.ColMetaData[Col].AliasName; 
        end; // if Row=0 
  
        //----------------------------------- 
        // récupération de la valeur du champ 
        //----------------------------------- 
  
        // type originel avant conversion éventuelle dans la requête 
        // sinon, non défini (d'après manuel 3.8.7, vu le 20/11/2014) 
        ColType := sqlite3_column_type( FStatement, Col); // à récupérer à chaque fois car typage dynamique 
        FField:=TlyField.Create(FullName, TlyFieldType(ColType)); // ou OriginName ?????????? 
  
        case ColType of 
          SQLITE_INTEGER : FField.AsInteger :=         sqlite3_column_int64(  FStatement, Col) ; 
          SQLITE_FLOAT   : FField.AsFloat   :=         sqlite3_column_double( FStatement, Col) ; 
          SQLITE_TEXT    : FField.AsText    := StrPas( sqlite3_column_text(   FStatement, Col) ); 
          SQLITE_BLOB    : begin 
                             Blob           :=         sqlite3_column_blob(   FStatement, Col) ; 
                             if Assigned(Blob) 
                             then begin 
                               iSize        :=         sqlite3_column_bytes(  FStatement, Col) ; 
                               tms:=TMemoryStream.Create; 
                               tms.SetSize(iSize); 
                               Move(Blob[0], tms.Memory^, iSize); 
                               FField.StreamToBlob(tms); 
                               tms.Free; 
                             end 
                             else FField.Clear; 
                          end; 
          SQLITE_NULL    : FField.Clear; 
         else FField.Clear; 
        end; 
  
        // à récupérer avant le AddField qui renverra nil pour FField 
        // en devenant propriétaire du champ qu'il intègre à sa table 
        Value := FField.AsText; // quel est le AsText d'un Blob ? chaîne qui dit 'BLOB de x octets' 
  
        try 
          //---------------------- 
          // on renseigne la table 
          //---------------------- 
          aTable.AddField(FField); 
        except 
          on E: Exception 
          do begin 
            DoLog('Error : '+E.Message+#10#13 
                  +' with ToTable statement : '+Requete); 
            FreeAndNil(FField); // car aTable pas devenue propriétaire de l'objet 
            if sqlite3_finalize(FStatement)=SQLITE_OK 
            then FStatement:=nil;  // sinon, sera repassé dans Finalize au Destroy 
            Exit; 
          end; 
        end; 
  
        //---------------------------------------------------- 
        // déclenchement événement (CallBack) nouvelle colonne 
        //---------------------------------------------------- 
        if Assigned(OnNewCol) then OnNewCol(self, AliasName, Value); 
  
      end; // for col 
  
      //--------------------------- 
      // traitement de fin de ligne 
      //--------------------------- 
  
      Inc(Row); 
      try 
        aTable.EndRow; 
      except 
        on E: Exception 
        do begin 
          DoLog('Error : '+E.Message+#10#13 
                +' with ToTable statement : '+Requete); 
          if sqlite3_finalize(FStatement)=SQLITE_OK 
          then FStatement:=nil;  // sinon, sera repassé dans Finalize au Destroy 
          Exit; 
        end; 
      end; 
  
      //------------------------------------------------ 
      // déclenchement événement (CallBack) fin de ligne 
      //------------------------------------------------ 
      if Assigned(OnEndRow) then OnEndRow(self); 
  
      // y a-t-il une ligne suivante ? 
      ErrCode:=sqlite3_step(FStatement); 
  
    end; // while ErrCode=SQLITE_ROW 
  
    //------------------------------------------------------------------------------------------------------------------- 
    // qu'il y ait eu ou non lignes de résultat traités dans le while (un UPDATE donne directement SQLITE_DONE ou erreur) 
    //------------------------------------------------------------------------------------------------------------------- 
    Result := ( ErrCode = SQLITE_DONE ); 
  
    if Result then 
    begin 
      try 
        aTable.EndFilling(self, DB, @UpdateFromTable, aUpdateDBIfTableChange); 
        ErrCode:=SQLITE_OK; 
        if LogRequests 
        then DoLog('Request : '+Requete); 
      except 
        on E: Exception 
        do begin 
          DoLog('Error : '+E.Message+#10#13 
                +' with ToTable statement : '+Requete); 
          if sqlite3_finalize(FStatement)=SQLITE_OK 
          then FStatement:=nil;  // sinon, sera repassé dans Finalize au Destroy 
          Exit; 
        end; 
      end; 
    end 
    else begin 
      FLastErrorCode:=ErrCode; 
      aTable.Clear; 
      Error:=sqlite3_errmsg; 
      FLastErrorMsg:=StrPas(Error); 
      DoLog('Error : '+FLastErrorMsg+' for request : '+Requete); 
    end; 
  
    if sqlite3_finalize(FStatement)=SQLITE_OK 
    then FStatement:=nil;  // sinon, sera repassé dans Finalize au Destroy 
  
  end // if aTable is TlySQLiteTable 
  else ErrCode:=LYSQLITEDB_NOTASSIGNED; 
  Result := (setLastError(ErrCode) = SQLITE_OK); 
end;

1
2
3
4
5
6
7
// callback de l'objet gérant la BD exécutant une requête 
function TlySQLiteDB.UpdateFromTable(aTable: TlySQLiteTable; aSQL: string): Boolean; 
begin 
  Result:=False; 
  if (aTable.DataBase<>self) or (aTable.Connexion<>DB) then Exit; 
  Result:=Execute(aSQL); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
// pour mettre à jour la BD quand un champ de la Table est modifié 
function TlySQLiteTable.UpdateDB(aCol, aRow: Integer; aValue: string): Boolean; 
var 
  RowidCol: integer; 
  Affinity: TlyFieldAffinity; 
  TableName, FieldName, RowidName, Value, SQL: string; 
begin 
  Result:=False; 
  if (DataBase=nil) or (Connexion=nil) or (FUpdateFromTable=nil) or ColMetaData[aCol].IsView or (ColMetaData[aCol].FieldType=ftBlob) then Exit; 
  RowidCol:=ColMetaData[aCol].RowidCol; 
  if RowidCol<0 then Exit; // vaut -1 si IsRowid ou pas de colonne Rowid => non modifiable 
  TableName:=ColMetaData[aCol].DBName+'.'+ColMetaData[aCol].TableName; 
  FieldName:=ColMetaData[aCol].OriginName; 
  RowidName:=ColMetaData[RowidCol].OriginName; // ou AliasName ????????????????? 
  Affinity:=ColMetaData[aCol].Affinity; 
  if Affinity in [faInteger, faReal, faNumeric] 
  then Value:=aValue 
  else Value:=AnsiQuotedStr(aValue, QuoteChar); // tant pis si typage dynamique ! 
  SQL:='UPDATE '+TableName+' SET '+FieldName+' = '+Value+' WHERE '+RowidName+' = '+Field[RowidCol, aRow].AsSQL; 
  // seul lySQLiteDB interagira avec la base 
  // et pourra garder les requêtes d'Update en log 
  Result:=FUpdateFromTable(self, SQL); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TlyField.SetText(aValue: string); // valeur textuelle qui devra être quotée 
var 
  NewValue: string; 
begin 
  if Pos(#0, aValue) > 0 then 
    raise Exception.Create('Présence du caractère nul, interdit dans une chaîne'); 
  NewValue:=aValue; // car aValue ne doit pas être modifiée 
  if Assigned(FOnValueChange) then 
    FOnValueChange(self, FCol, FRow, FText, NewValue); 
  FText:=NewValue; // peut avoir été restauré à FText par FOnValueChange (échec synchro BD par ex.) 
  FType:=ftText; 
  bText:=True; 
  FNull:=False; 
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
procedure TlySQLiteTable.OnFieldChange(sender: TObject; aCol, aRow: Integer; const OldValue: string; var NewValue: string); 
var 
  TheCol, TheRow: integer; 
begin 
  if NewValue<>OldValue then // sinon, pas la peine de se fatiguer ! 
  try 
    if (Sender as TlyField).Table<>self then 
      raise Exception.Create('no Table link'); 
    TheCol:=-1; 
    if FBiDiUpdate // synchronisation avec la grille 
    then begin 
      if not Assigned(FGrid) then 
        raise Exception.Create('no Grid link'); 
      TheRow:=aRow+FRowShift; 
      TheCol:=ColToGrid[aCol]; 
      if TheCol>-1 then FGrid.Cells[TheCol, TheRow]:=NewValue; 
    end; 
    if FUpdateIfModified // synchronisation avec la BD 
    then begin 
      if not UpdateDB(aCol, aRow, NewValue) 
      then begin 
        if TheCol>-1 then FGrid.Cells[TheCol, TheRow]:=OldValue; // marche arrière ! 
        raise Exception.Create('DB did not sync'); 
      end; 
    end; 
  except 
    NewValue:=OldValue; 
  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
32
TlySQLiteTable.OnCellChange(Sender: TObject; aCol, aRow: Integer; const OldValue: string; var NewValue: String); 
const 
  AffToType: array[TlyFieldAffinity] of TlyFieldType = (ftInteger, ftText, ftBLOB, ftFloat, ftFloat, ftUnknown); 
var 
  TheField: TlyField; 
  TheCol, TheRow: integer; 
  Affinity: TlyFieldAffinity; 
begin 
  if FBiDiUpdate and (NewValue<>OldValue) then // sinon, pas la peine de se fatiguer ! 
  try 
    if (Sender<>FGrid) then raise Exception.Create('no link'); 
    TheCol:=GridToCol[aCol]; // si jamais des colonnes avaient été ajoutées à la grille... 
    Affinity:=ColMetaData[TheCol].Affinity; 
    TheRow:=aRow-FRowShift;  // ou son nombre de lignes modifié... 
    TheField:=Field[TheCol, TheRow]; // d'abord, en cas d'index hors limite... 
    if UpdateIfModified // synchronisation avec la BD 
    then begin 
      if not UpdateDB(TheCol, TheRow, NewValue) 
      then raise Exception.Create('DB did not sync'); 
    end; 
    // MAJ table avec affectation directe des champs pour ne pas déclencher OnFieldChange 
    TheField.FText:=NewValue; 
    TheField.FNull:=False; 
    if TheField.FieldType in [ftUnknown, ftNull] 
    then TheField.FType:=AffToType[Affinity]; // ne peut donc plus rester ftNull alors qu'on a attribué une valeur 
    if Affinity=faText 
    then TheField.bText:=True 
    else TheField.bText:=False; 
  except 
    NewValue:=OldValue; 
  end; 
end;