File: unit1.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (454 lines) | stat: -rw-r--r-- 14,593 bytes parent folder | download | duplicates (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
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
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
unit Unit1;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//   This is free and unencumbered software released into the public domain.  //
//                                                                            //
//   Anyone is free to copy, modify, publish, use, compile, sell, or          //
//   distribute this software, either in source code form or as a compiled    //
//   binary, for any purpose, commercial or non-commercial, and by any        //
//   means.                                                                   //
//                                                                            //
//   In jurisdictions that recognize copyright laws, the author or authors    //
//   of this software dedicate any and all copyright interest in the          //
//   software to the public domain. We make this dedication for the benefit   //
//   of the public at large and to the detriment of our heirs and             //
//   successors. We intend this dedication to be an overt act of              //
//   relinquishment in perpetuity of all present and future rights to this    //
//   software under copyright law.                                            //
//                                                                            //
//   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,          //
//   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF       //
//   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   //
//   IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR        //
//   OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,    //
//   ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR    //
//   OTHER DEALINGS IN THE SOFTWARE.                                          //
//                                                                            //
//   For more information, please refer to <http://unlicense.org/>            //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////


// For this test application, I wanted to very simply try the following
// capabilities which I'll be using in a large application:
// - Creation of a SQLite3 Database
// - Creation of a database table
// - Setting various database metadata (PRAGMA)
// - Optionally encrypt the database using a key
// - Change (or set if not initially set) the encryption key for the database

// The application makes a new database file "new.db" within the local directory
// See readme.txt for installation instructions and details




{$mode objfpc}{$H+}

interface

uses
  SysUtils, db, sqldb, sqlite3conn, Forms, Dialogs, StdCtrls, ExtCtrls, DBGrids;

type

  { TForm1 }

  TForm1 = class(TForm)
    btnMakeNewDB: TButton;
    btnReKeyDB: TButton;
    btnViewAppID: TButton;
    btnSetAppID: TButton;
    btnViewUserVersion: TButton;
    btnSetUserVersion: TButton;
    btnAddToDB: TButton;
    btnUpdateGrid: TButton;
    btnCountRows: TButton;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Label12: TLabel;
    Shape4: TShape;
    Shape5: TShape;
    txtUser_Name: TEdit;
    txtInfo: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    txtNew: TEdit;
    txtApplication_ID: TEdit;
    Label2: TLabel;
    SQLite3Connection1: TSQLite3Connection;
    SQLQuery1: TSQLQuery;
    SQLTransaction1: TSQLTransaction;
    txtUser_Version: TEdit;
    txtPass: TEdit;
    procedure btnAddToDBClick(Sender: TObject);
    procedure btnMakeNewDBClick(Sender: TObject);
    procedure btnReKeyDBClick(Sender: TObject);
    procedure btnSetAppIDClick(Sender: TObject);
    procedure btnSetUserVersionClick(Sender: TObject);
    procedure btnViewAppIDClick(Sender: TObject);
    procedure btnViewUserVersionClick(Sender: TObject);
    procedure btnUpdateGridClick(Sender: TObject);
    procedure btnCountRowsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  const
    // More information on the use of these values is below.
    // They need not be set as constants in your application. They can be any valid value
    application_id = 1189021115; // must be a 32-bit Unsigned Integer (Longword 0 .. 4294967295)
    user_version = 23400001;  // must be a 32-bit Signed Integer (LongInt -2147483648 .. 2147483647)

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnMakeNewDBClick(Sender: TObject);
var
  newFile : Boolean;
begin

  SQLite3Connection1.Close; // Ensure the connection is closed when we start

  // Set the password initially.
  // Could probably be done with a PRAGMA statement, but this is so much simpler
  // and once set, doesn't need to be reset every time we open the database.
  // txtPass can be left blank if you want an unencrypted database.
  SQLite3Connection1.Password := txtPass.Text;

  try

    // Since we're making this database for the first time,
    // check whether the file already exists
    newFile := not FileExists(SQLite3Connection1.DatabaseName);

    if newFile then
    begin

      // Make the database and the tables
      try
        SQLite3Connection1.Open;
        SQLTransaction1.Active := true;


        // Per the SQLite Documentation (edited for clarity):
        // The pragma user_version is used to set or get the value of the user-version.
        // The user-version is a big-endian 32-bit signed integer stored in the database header at offset 60.
        // The user-version is not used internally by SQLite. It may be used by applications for any purpose.
        // http://www.sqlite.org/pragma.html#pragma_schema_version
        SQLite3Connection1.ExecuteDirect('PRAGMA user_version = ' + IntToStr(user_version) + ';');


        // Per the SQLite Documentation:
        // The application_id PRAGMA is used to query or set the 32-bit unsigned big-endian
        // "Application ID" integer located at offset 68 into the database header.
        // Applications that use SQLite as their application file-format should set the
        // Application ID integer to a unique integer so that utilities such as file(1) can
        // determine the specific file type rather than just reporting "SQLite3 Database".
        // A list of assigned application IDs can be seen by consulting the magic.txt file
        // in the SQLite source repository. 
        // http://www.sqlite.org/pragma.html#pragma_application_id
        SQLite3Connection1.ExecuteDirect('PRAGMA application_id = ' + IntToStr(application_id) + ';');


        // Here we're setting up a table named "DATA" in the new database
        SQLite3Connection1.ExecuteDirect('CREATE TABLE "DATA"('+
                    ' "id" Integer NOT NULL PRIMARY KEY AUTOINCREMENT,'+
                    ' "Current_Time" DateTime NOT NULL,'+
                    ' "User_Name" Char(128) NOT NULL,'+
                    ' "Info" Char(128) NOT NULL);');


        // Creating an index based upon id in the DATA Table
        SQLite3Connection1.ExecuteDirect('CREATE UNIQUE INDEX "Data_id_idx" ON "DATA"( "id" );');


        SQLTransaction1.Commit;

        ShowMessage('Succesfully created database.');

      except
        ShowMessage('Unable to Create new Database');
      end;

    end;

  except
    ShowMessage('Unable to check if database file exists');
  end;

end;

procedure TForm1.btnAddToDBClick(Sender: TObject);
begin
  SQLite3Connection1.Password := txtPass.Text; // The current password

  if (txtUser_Name.Text = '') OR (txtInfo.Text = '') then
  begin
    ShowMessage('Please enter both a Name and Info');
  end
  else
  begin

    // Attempt to add txtUser_Name and txtInfo to the database
    try
      SQLite3Connection1.Open;
      SQLTransaction1.Active := True;

      // Insert the values into the database
      // We're using ParamByName which prevents SQL Injection
      // http://wiki.freepascal.org/Working_With_TSQLQuery#Parameters_in_TSQLQuery.SQL
      SQLQuery1.SQL.Text := 'Insert into DATA (Current_Time,User_Name,Info) values (:Current_Time,:User_Name,:Info)';
      SQLQuery1.Params.ParamByName('Current_Time').AsDateTime := Now;
      SQLQuery1.Params.ParamByName('User_Name').AsString := txtUser_Name.Text;
      SQLQuery1.Params.ParamByName('Info').AsString := txtInfo.Text;
      SQLQuery1.ExecSQL;

      SQLTransaction1.Commit;

      // Clear Edit boxes
      txtUser_Name.Text := '';
      txtInfo.Text := '';

      // Now let's update the grid to show the new values to the user:
      btnUpdateGridClick(nil);
    except
      ShowMessage('Unable to add User_Name: ' + txtUser_Name.Text + ' and Info: ' + txtInfo.Text + ' to the database. Ensure database exists and password is correct.');
    end;

  end;

end;

procedure TForm1.btnReKeyDBClick(Sender: TObject);
begin

  SQLite3Connection1.Close; // Ensure the connection is closed when we start

  SQLite3Connection1.Password := txtPass.Text; // The current password

  // Update the database key
  try
    SQLite3Connection1.Open;
    SQLTransaction1.Active := True;


    // Here we change the key.
    // We use double-quotes here so that a blank key (IE: "") can be provided if
    // you want to remove encryption from the database.
    // This is a very simplistic demonstration. Ideally, we would take a stronger cryptographic approach
    // Some helpful info on this topic can be found at:
    // https://www.owasp.org/index.php/Cheat_Sheets
    // Per SQLite Documentation:
    // Note that the hexkey, rekey and hexrekey pragmas only work with SQLite version 3.6.8 and later.
    // http://www.sqlite.org/see/doc/trunk/www/readme.wiki
    // Section: Using the "key" PRAGMA
    SQLite3Connection1.ExecuteDirect('PRAGMA rekey = ' + QuotedStr(txtNew.Text) + ';');


    SQLTransaction1.Commit;
    SQLite3Connection1.Close;

    // Transfer the password to txtPass and erase txtNew
    txtPass.Text := txtNew.Text;
    txtNew.Text := '';

    // ... and make sure we remember the new password in our sqlconnection ready
    // for reconnecting
    SQLite3Connection1.Password := txtPass.Text;

    ShowMessage('Password rekey succesful.');

  except
    ShowMessage('Unable to set the new key using: PRAGMA rekey = ' + txtNew.Text + ';');
  end;

end;

procedure TForm1.btnSetAppIDClick(Sender: TObject);
begin

  SQLite3Connection1.Close; // Ensure the connection is closed when we start

  SQLite3Connection1.Password := txtPass.Text; // The current password

  // Try to set the application_id Pragma
  try
    SQLite3Connection1.Open;
    SQLTransaction1.Active := True;


    SQLQuery1.SQL.Text := 'PRAGMA application_id = ' + txtApplication_ID.Text + ';';
    SQLQuery1.ExecSQL;


    SQLTransaction1.Commit;
    SQLite3Connection1.Close;

    ShowMessage('SetAppID succesful');

  except
    ShowMessage('Unable to set new application_id: ' + txtApplication_ID.Text + ';');
  end;

end;

procedure TForm1.btnSetUserVersionClick(Sender: TObject);
begin

  SQLite3Connection1.Close; // Ensure the connection is closed when we start

  SQLite3Connection1.Password := txtPass.Text; // The current password

  // Try to set the user_version Pragma
  try
    SQLite3Connection1.Open;
    SQLTransaction1.Active := True;


    SQLQuery1.SQL.Text := 'PRAGMA user_version = ' + txtUser_Version.Text + ';';
    SQLQuery1.ExecSQL;


    SQLTransaction1.Commit;
    SQLite3Connection1.Close;

    ShowMessage('SetUserVersion succesful.');

  except
    ShowMessage('Unable to set user_version: ' + txtUser_Version.Text + ';');
  end;

end;

procedure TForm1.btnViewAppIDClick(Sender: TObject);
begin

  SQLite3Connection1.Close; // Ensure the connection is closed when we start

  SQLite3Connection1.Password := txtPass.Text; // The current password

  // Try to query database for application_id Pragma
  try
    SQLite3Connection1.Open;

    SQLQuery1.SQL.Text := 'PRAGMA application_id;';
    SQLQuery1.Open;

    // Display the resulting value
    ShowMessage('application_id is: '+SQLQuery1.fields[0].asString);

  except
    ShowMessage('Unable to display application_id');
  end;

end;

procedure TForm1.btnViewUserVersionClick(Sender: TObject);
begin

  SQLite3Connection1.Close; // Ensure the connection is closed when we start

  SQLite3Connection1.Password := txtPass.Text; // The current password

  // Try to query database for user_version Pragma
  try
    SQLite3Connection1.Open;

    SQLQuery1.SQL.Text := 'PRAGMA user_version;';
    SQLQuery1.Open;

    // Display the resulting value
    ShowMessage('user_version is: '+SQLQuery1.fields[0].asString);

  except
    ShowMessage('Unable to display user_version');
  end;

end;

procedure TForm1.btnUpdateGridClick(Sender: TObject);
begin

  SQLite3Connection1.Password := txtPass.Text; // The current password

  // Try to perform query
  try
    SQLite3Connection1.Connected := True;

    // Set SQL text to select everything from the DATA table
    SQLQuery1.SQL.Clear;
    SQLQuery1.SQL.Text := 'Select * from DATA';
    SQLQuery1.Open;

    // Allow the DBGrid to view the results of our query
    DataSource1.DataSet := SQLQuery1;
    DBGrid1.DataSource := DataSource1;
    DBGrid1.AutoFillColumns := true;

  except
    ShowMessage('Unable to query the database');
  end;

end;

procedure TForm1.btnCountRowsClick(Sender: TObject);
begin

  SQLite3Connection1.Close; // Ensure the connection is closed when we start

  SQLite3Connection1.Password := txtPass.Text; // The current password

  // Try to perform query
  try
    SQLite3Connection1.Connected := True;

    // Set SQL text to count all rows from the DATA table
    SQLQuery1.SQL.Clear;
    SQLQuery1.SQL.Text := 'Select Count(*) from DATA';
    SQLQuery1.Open;

    // Allow the DBGrid to view the results of our query
    DataSource1.DataSet := SQLQuery1;
    DBGrid1.DataSource := DataSource1;
    DBGrid1.AutoFillColumns := true;

  except
    ShowMessage('Unable to query the database');
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  // Ensure we're using the local sqlite3.dll
  SQLiteLibraryName := 'sqlite3.dll';

  // Set the path to the database
  SQLite3Connection1.DatabaseName := 'new.db';

end;

end.