Check-in [19a962fef4]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:First working version
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 19a962fef4577e0c623fe2ef169b2b53075ae916
User & Date: MCO 2011-05-04 11:02:02
Context
2011-05-04
13:07
Added icon, keyboard shortcuts check-in: 25b06ad3a6 user: MCO tags: trunk
11:02
First working version check-in: 19a962fef4 user: MCO tags: trunk
10:59
First working version check-in: a9d77b7171 user: MCO tags: trunk
Changes

Added src/lib/SQLite3.pas.

















































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
unit SQLite3;

{
  Simplified interface for SQLite.
  Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com)
  Note: NOT COMPLETE for version 3, just minimal functionality
  Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net)
  which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch)
}

{$IFDEF FPC}
  {$MODE DELPHI}
  {$H+}            (* use AnsiString *)
  {$PACKENUM 4}    (* use 4-byte enums *)
  {$PACKRECORDS C} (* C/C++-compatible record packing *)
{$ELSE}
  {$MINENUMSIZE 4} (* use 4-byte enums *)
{$ENDIF}

interface

const
{$IF Defined(MSWINDOWS)}
  SQLiteDLL = 'sqlite3.dll';
{$ELSEIF Defined(DARWIN)}
  SQLiteDLL = 'libsqlite3.dylib';
  {$linklib libsqlite3}
{$ELSEIF Defined(UNIX)}
  SQLiteDLL = 'sqlite3.so';
{$IFEND}

// Return values for sqlite3_exec() and sqlite3_step()

const
  SQLITE_OK          =  0; // Successful result
  (* beginning-of-error-codes *)
  SQLITE_ERROR       =  1; // SQL error or missing database
  SQLITE_INTERNAL    =  2; // An internal logic error in SQLite
  SQLITE_PERM        =  3; // Access permission denied
  SQLITE_ABORT       =  4; // Callback routine requested an abort
  SQLITE_BUSY        =  5; // The database file is locked
  SQLITE_LOCKED      =  6; // A table in the database is locked
  SQLITE_NOMEM       =  7; // A malloc() failed
  SQLITE_READONLY    =  8; // Attempt to write a readonly database
  SQLITE_INTERRUPT   =  9; // Operation terminated by sqlite3_interrupt()
  SQLITE_IOERR       = 10; // Some kind of disk I/O error occurred
  SQLITE_CORRUPT     = 11; // The database disk image is malformed
  SQLITE_NOTFOUND    = 12; // (Internal Only) Table or record not found
  SQLITE_FULL        = 13; // Insertion failed because database is full
  SQLITE_CANTOPEN    = 14; // Unable to open the database file
  SQLITE_PROTOCOL    = 15; // Database lock protocol error
  SQLITE_EMPTY       = 16; // Database is empty
  SQLITE_SCHEMA      = 17; // The database schema changed
  SQLITE_TOOBIG      = 18; // Too much data for one row of a table
  SQLITE_CONSTRAINT  = 19; // Abort due to contraint violation
  SQLITE_MISMATCH    = 20; // Data type mismatch
  SQLITE_MISUSE      = 21; // Library used incorrectly
  SQLITE_NOLFS       = 22; // Uses OS features not supported on host
  SQLITE_AUTH        = 23; // Authorization denied
  SQLITE_FORMAT      = 24; // Auxiliary database format error
  SQLITE_RANGE       = 25; // 2nd parameter to sqlite3_bind out of range
  SQLITE_NOTADB      = 26; // File opened that is not a database file
  SQLITE_ROW         = 100; // sqlite3_step() has another row ready
  SQLITE_DONE        = 101; // sqlite3_step() has finished executing

  SQLITE_INTEGER = 1;
  SQLITE_FLOAT   = 2;
  SQLITE_TEXT    = 3;
  SQLITE_BLOB    = 4;
  SQLITE_NULL    = 5;

  SQLITE_UTF8     = 1;
  SQLITE_UTF16    = 2;
  SQLITE_UTF16BE  = 3;
  SQLITE_UTF16LE  = 4;
  SQLITE_ANY      = 5;

  SQLITE_STATIC    {: TSQLite3Destructor} = Pointer(0);
  SQLITE_TRANSIENT {: TSQLite3Destructor} = Pointer(-1);

type
  TSQLiteDB = Pointer;
  TSQLiteResult = ^PAnsiChar;
  TSQLiteStmt = Pointer;

type
  PPAnsiCharArray = ^TPAnsiCharArray; 
  TPAnsiCharArray = array[0 .. (MaxInt div SizeOf(PAnsiChar))-1] of PAnsiChar;

type
  TSQLiteExecCallback = function(UserData: Pointer; NumCols: integer; ColValues:
    PPAnsiCharArray; ColNames: PPAnsiCharArray): integer; cdecl;
  TSQLiteBusyHandlerCallback = function(UserData: Pointer; P2: integer): integer; cdecl;

  //function prototype for define own collate
  TCollateXCompare = function(UserData: pointer; Buf1Len: integer; Buf1: pointer;
    Buf2Len: integer; Buf2: pointer): integer; cdecl;

function SQLite3_Initialize(): integer; cdecl; external SQLiteDLL name 'sqlite3_initialize';
function SQLite3_Shutdown(): integer; cdecl; external SQLiteDLL name 'sqlite3_shutdown';

function SQLite3_Open(const filename: PAnsiChar; var db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_open';
function SQLite3_Open_v2(const filename: PAnsiChar; var db: TSQLiteDB; flags: integer; const vfs: PAnsiChar):integer;cdecl; external SQLiteDLL name 'sqlite3_open_v2';
function SQLite3_Close(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_close';
function SQLite3_Exec(db: TSQLiteDB; SQLStatement: PAnsiChar; CallbackPtr: TSQLiteExecCallback; UserData: Pointer; var ErrMsg: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_exec';
function SQLite3_Version(): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_libversion';
function SQLite3_ErrMsg(db: TSQLiteDB): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_errmsg';
function SQLite3_ErrCode(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_errcode';
procedure SQlite3_Free(P: PAnsiChar); cdecl; external SQLiteDLL name 'sqlite3_free';
function SQLite3_GetTable(db: TSQLiteDB; SQLStatement: PAnsiChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_get_table';
procedure SQLite3_FreeTable(Table: TSQLiteResult); cdecl; external SQLiteDLL name 'sqlite3_free_table';
function SQLite3_Complete(P: PAnsiChar): boolean; cdecl; external SQLiteDLL name 'sqlite3_complete';
function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external SQLiteDLL name 'sqlite3_last_insert_rowid';
procedure SQLite3_Interrupt(db: TSQLiteDB); cdecl; external SQLiteDLL name 'sqlite3_interrupt';
procedure SQLite3_BusyHandler(db: TSQLiteDB; CallbackPtr: TSQLiteBusyHandlerCallback; UserData: Pointer); cdecl; external SQLiteDLL name 'sqlite3_busy_handler';
procedure SQLite3_BusyTimeout(db: TSQLiteDB; TimeOut: integer); cdecl; external SQLiteDLL name 'sqlite3_busy_timeout';
function SQLite3_Changes(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_changes';
function SQLite3_TotalChanges(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_total_changes';
function SQLite3_Prepare(db: TSQLiteDB; SQLStatement: PAnsiChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_prepare';
function SQLite3_Prepare_v2(db: TSQLiteDB; SQLStatement: PAnsiChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PAnsiChar): integer; cdecl; external SQLiteDLL name 'sqlite3_prepare_v2';
function SQLite3_SQL(hStmt: TSqliteStmt): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_sql';
function SQLite3_ColumnCount(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_column_count';
function SQLite3_ColumnName(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_name';
function SQLite3_ColumnDeclType(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_decltype';
function SQLite3_Step(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_step';
function SQLite3_DataCount(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_data_count';

function SQLite3_ColumnBlob(hStmt: TSqliteStmt; ColNum: integer): pointer; cdecl; external SQLiteDLL name 'sqlite3_column_blob';
function SQLite3_ColumnBytes(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_bytes';
function SQLite3_ColumnDouble(hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external SQLiteDLL name 'sqlite3_column_double';
function SQLite3_ColumnInt(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_int';
function SQLite3_ColumnText(hStmt: TSqliteStmt; ColNum: integer): PAnsiChar; cdecl; external SQLiteDLL name 'sqlite3_column_text';
function SQLite3_ColumnType(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_column_type';
function SQLite3_ColumnInt64(hStmt: TSqliteStmt; ColNum: integer): Int64; cdecl; external SQLiteDLL name 'sqlite3_column_int64';
function SQLite3_Finalize(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_finalize';
function SQLite3_Reset(hStmt: TSqliteStmt): integer; cdecl; external SQLiteDLL name 'sqlite3_reset';
function SQLite3_Get_Autocommit(db: TSQLiteDB): integer; cdecl; external SQLiteDLL name 'sqlite3_get_autocommit';

// 
// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(),
// one or more literals can be replace by a wildcard "?" or ":N:" where
// N is an integer.  These value of these wildcard literals can be set
// using the routines listed below.
// 
// In every case, the first parameter is a pointer to the sqlite3_stmt
// structure returned from sqlite3_prepare().  The second parameter is the
// index of the wildcard.  The first "?" has an index of 1.  ":N:" wildcards
// use the index N.
// 
// The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and
//sqlite3_bind_text16() is a destructor used to dispose of the BLOB or
//text after SQLite has finished with it.  If the fifth argument is the
// special value SQLITE_STATIC, then the library assumes that the information
// is in static, unmanaged space and does not need to be freed.  If the
// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its
// own private copy of the data.
// 
// The sqlite3_bind_* routine must be called before sqlite3_step() after
// an sqlite3_prepare() or sqlite3_reset().  Unbound wildcards are interpreted
// as NULL.
// 

type
  TSQLite3Destructor = procedure(Ptr: Pointer); cdecl;

function sqlite3_bind_blob(hStmt: TSqliteStmt; ParamNum: integer;
  ptrData: pointer; numBytes: integer; ptrDestructor: TSQLite3Destructor): integer;
cdecl; external SQLiteDLL name 'sqlite3_bind_blob';
function sqlite3_bind_text(hStmt: TSqliteStmt; ParamNum: integer;
  Text: PAnsiChar; numBytes: integer; ptrDestructor: TSQLite3Destructor): integer;
cdecl; external SQLiteDLL name 'sqlite3_bind_text';
function sqlite3_bind_double(hStmt: TSqliteStmt; ParamNum: integer; Data: Double): integer;
  cdecl; external SQLiteDLL name 'sqlite3_bind_double';
function sqlite3_bind_int(hStmt: TSqLiteStmt; ParamNum: integer; Data: integer): integer;
  cdecl; external SQLiteDLL name 'sqlite3_bind_int';
function sqlite3_bind_int64(hStmt: TSqliteStmt; ParamNum: integer; Data: int64): integer;
  cdecl; external SQLiteDLL name 'sqlite3_bind_int64';
function sqlite3_bind_null(hStmt: TSqliteStmt; ParamNum: integer): integer;
  cdecl; external SQLiteDLL name 'sqlite3_bind_null';

function sqlite3_bind_parameter_index(hStmt: TSqliteStmt; zName: PAnsiChar): integer;
  cdecl; external SQLiteDLL name 'sqlite3_bind_parameter_index';
function sqlite3_bind_parameter_count(hStmt: TSqliteStmt): integer;
  cdecl; external SQLiteDLL name 'sqlite3_bind_parameter_count';
function sqlite3_bind_parameter_name(hStmt: TSqliteStmt; ParamNum: Integer): PAnsiChar;
  cdecl; external SQLiteDLL name 'sqlite3_bind_parameter_name';

function sqlite3_clear_bindings(hStmt: TSqliteStmt): integer;
  cdecl; external SQLiteDLL name 'sqlite3_clear_bindings';

function sqlite3_enable_shared_cache(Value: integer): integer; cdecl; external SQLiteDLL name 'sqlite3_enable_shared_cache';

//user collate definiton
function SQLite3_create_collation(db: TSQLiteDB; Name: PAnsiChar; eTextRep: integer;
  UserData: pointer; xCompare: TCollateXCompare): integer; cdecl; external SQLiteDLL name 'sqlite3_create_collation';


function sqlite3_load_extension(db: TSQLiteDB; const zFile: PAnsiChar; const zProc: PAnsiChar; var pzErrMsg: PAnsiChar): Integer; cdecl; external SQLiteDLL;
function sqlite3_enable_load_extension(db: TSQLiteDB; onoff: Integer): Integer; cdecl; external SQLiteDLL;



function StringToPUTF8Char(Text: string): PAnsiChar; inline;
function PUTF8CharToString(Text: PAnsiChar): string;

function SQLiteFieldType(SQLiteFieldTypeCode: Integer): string;
function SQLiteErrorStr(SQLiteErrorCode: Integer): string;

implementation

uses
  SysUtils, Windows;

{ ------------------------------------------------------------------------------------------------ }
function StringToPUTF8Char(Text: string): PAnsiChar;
var
  UText: UTF8String;
//  ByteLength: Integer;
begin
  if Text = '' then begin
    Result := nil;
    Exit;
  end;
{$IFDEF UNICODE}
  UText := UTF8String(Copy(Text, 1));
  Result := PAnsiChar(UText);
//  ByteLength := WideCharToMultiByte(CP_UTF8, WC_ERR_INVALID_CHARS, PChar(Text), Length(Text), nil, 0, nil, nil);
//  if ByteLength = 0 then
//    RaiseLastOSError;
////  SetLength(UText, ByteLength);
//  UText := UTF8String(StringOfChar(AnsiChar(' '), ByteLength));
//  Result := PAnsiChar(UText);
//  WideCharToMultiByte(CP_UTF8, WC_ERR_INVALID_CHARS, PChar(Text), Length(Text), Result, ByteLength, nil, nil);
{$ELSE}
  UText := AnsiToUtf8(Text);
  Result := PAnsiChar(UText);
{$ENDIF}
end;
{ ------------------------------------------------------------------------------------------------ }
function PUTF8CharToString(Text: PAnsiChar): string;
begin
{$IFDEF UNICODE}
  Result := Utf8ToUnicodeString(Text);
{$ELSE}
  Result := Utf8ToAnsi(Text);
{$ENDIF}
end;


{ ------------------------------------------------------------------------------------------------ }
function SQLiteFieldType(SQLiteFieldTypeCode: Integer): string;
begin
  case SQLiteFieldTypeCode of
    SQLITE_INTEGER: Result := 'Integer';
    SQLITE_FLOAT: Result := 'Float';
    SQLITE_TEXT: Result := 'Text';
    SQLITE_BLOB: Result := 'Blob';
    SQLITE_NULL: Result := 'Null';
  else
    Result := 'Unknown SQLite Field Type Code "' + IntToStr(SQLiteFieldTypeCode) + '"';
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function SQLiteErrorStr(SQLiteErrorCode: Integer): string;
begin
  case SQLiteErrorCode of
    SQLITE_OK: Result := 'Successful result';
    SQLITE_ERROR: Result := 'SQL error or missing database';
    SQLITE_INTERNAL: Result := 'An internal logic error in SQLite';
    SQLITE_PERM: Result := 'Access permission denied';
    SQLITE_ABORT: Result := 'Callback routine requested an abort';
    SQLITE_BUSY: Result := 'The database file is locked';
    SQLITE_LOCKED: Result := 'A table in the database is locked';
    SQLITE_NOMEM: Result := 'A malloc() failed';
    SQLITE_READONLY: Result := 'Attempt to write a readonly database';
    SQLITE_INTERRUPT: Result := 'Operation terminated by sqlite3_interrupt()';
    SQLITE_IOERR: Result := 'Some kind of disk I/O error occurred';
    SQLITE_CORRUPT: Result := 'The database disk image is malformed';
    SQLITE_NOTFOUND: Result := '(Internal Only) Table or record not found';
    SQLITE_FULL: Result := 'Insertion failed because database is full';
    SQLITE_CANTOPEN: Result := 'Unable to open the database file';
    SQLITE_PROTOCOL: Result := 'Database lock protocol error';
    SQLITE_EMPTY: Result := 'Database is empty';
    SQLITE_SCHEMA: Result := 'The database schema changed';
    SQLITE_TOOBIG: Result := 'Too much data for one row of a table';
    SQLITE_CONSTRAINT: Result := 'Abort due to contraint violation';
    SQLITE_MISMATCH: Result := 'Data type mismatch';
    SQLITE_MISUSE: Result := 'Library used incorrectly';
    SQLITE_NOLFS: Result := 'Uses OS features not supported on host';
    SQLITE_AUTH: Result := 'Authorization denied';
    SQLITE_FORMAT: Result := 'Auxiliary database format error';
    SQLITE_RANGE: Result := '2nd parameter to sqlite3_bind out of range';
    SQLITE_NOTADB: Result := 'File opened that is not a database file';
    SQLITE_ROW: Result := 'sqlite3_step() has another row ready';
    SQLITE_DONE: Result := 'sqlite3_step() has finished executing';
  else
    Result := 'Unknown SQLite Error Code "' + IntToStr(SQLiteErrorCode) + '"';
  end;
end;

function ColValueToStr(Value: PAnsiChar): AnsiString;
begin
  if (Value = nil) then
    Result := 'NULL'
  else
    Result := Value;
end;


end.

Added src/lib/SQLite3Abstract.pas.



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
unit SQLite3Abstract;

interface

uses
  SysUtils, Classes, Contnrs;

const
  SQLITE_OK          =  0; // Successful result
  (* beginning-of-error-codes *)
  SQLITE_ERROR       =  1; // SQL error or missing database
  SQLITE_INTERNAL    =  2; // An internal logic error in SQLite
  SQLITE_PERM        =  3; // Access permission denied
  SQLITE_ABORT       =  4; // Callback routine requested an abort
  SQLITE_BUSY        =  5; // The database file is locked
  SQLITE_LOCKED      =  6; // A table in the database is locked
  SQLITE_NOMEM       =  7; // A malloc() failed
  SQLITE_READONLY    =  8; // Attempt to write a readonly database
  SQLITE_INTERRUPT   =  9; // Operation terminated by sqlite3_interrupt()
  SQLITE_IOERR       = 10; // Some kind of disk I/O error occurred
  SQLITE_CORRUPT     = 11; // The database disk image is malformed
  SQLITE_NOTFOUND    = 12; // (Internal Only) Table or record not found
  SQLITE_FULL        = 13; // Insertion failed because database is full
  SQLITE_CANTOPEN    = 14; // Unable to open the database file
  SQLITE_PROTOCOL    = 15; // Database lock protocol error
  SQLITE_EMPTY       = 16; // Database is empty
  SQLITE_SCHEMA      = 17; // The database schema changed
  SQLITE_TOOBIG      = 18; // Too much data for one row of a table
  SQLITE_CONSTRAINT  = 19; // Abort due to contraint violation
  SQLITE_MISMATCH    = 20; // Data type mismatch
  SQLITE_MISUSE      = 21; // Library used incorrectly
  SQLITE_NOLFS       = 22; // Uses OS features not supported on host
  SQLITE_AUTH        = 23; // Authorization denied
  SQLITE_FORMAT      = 24; // Auxiliary database format error
  SQLITE_RANGE       = 25; // 2nd parameter to sqlite3_bind out of range
  SQLITE_NOTADB      = 26; // File opened that is not a database file
  SQLITE_ROW         = 100; // sqlite3_step() has another row ready
  SQLITE_DONE        = 101; // sqlite3_step() has finished executing

  SQLITE_INTEGER = 1;
  SQLITE_FLOAT   = 2;
  SQLITE_TEXT    = 3;
  SQLITE_BLOB    = 4;
  SQLITE_NULL    = 5;


type
  TCustomSQLiteDatabase = class;
  TCustomSQLiteCursor = class;
  TCustomSQLiteField = class;

  TCountEvent = procedure(Sender: TObject; Count: Integer) of object;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteDataType = (dtInt = SQLITE_INTEGER,
                     dtNumeric = SQLITE_FLOAT,
                     dtStr = SQLITE_TEXT,
                     dtBlob = SQLITE_BLOB,
                     dtNull = SQLITE_NULL);

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteValue = record
  public
    DataType: TSQLiteDataType;
    case TSQLiteDataType of
      dtInt: (Integer: Int64);
      dtNumeric: (Float: Double);
      dtStr: (Text: PChar);
      dtBlob: (Blob: TStream; OwnsBlob: Boolean);
      dtNull: ();
  end;
  PSQLiteValue = ^TSQLiteValue;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteColumnDef = class
  protected
    FCursor: TCustomSQLiteCursor;
  public
    Index: Integer;
    Name: string;
    DataType: TSQLiteDataType;

    constructor Create(Cursor: TCustomSQLiteCursor);

    function Clone(NewCursor: TCustomSQLiteCursor): TSQLiteColumnDef;

    property Cursor: TCustomSQLiteCursor read FCursor;
  end;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteRowData = class
  protected
    FCursor: TCustomSQLiteCursor;
    FValues: array of TSQLiteValue;

    function GetValue(Index: Integer): PSQLiteValue;
  public
    constructor Create(Parent: TCustomSQLiteCursor); virtual;
    destructor  Destroy; override;

    procedure CopyValue(ColIndex: Integer; SourceField: TCustomSQLiteField); virtual;
    function Clone(Parent: TCustomSQLiteCursor): TSQLiteRowData; virtual;

    property Parent: TCustomSQLiteCursor          read FCursor;
    property Value[Index: Integer]: PSQLiteValue  read GetValue;
  end;


  { ---------------------------------------------------------------------------------------------- }
  ESQLiteException = class(Exception)
  protected
    FSQL: string;
    FDBPath: string;
  public
    constructor Create(DBFile: string; Message: string); overload;
    constructor Create(DB: TCustomSQLiteDatabase; Message: string); overload;
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Message: string); overload;
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Code: Integer); overload;
    property SQL: string          read FSQL;
    property Database: string     read FDBPath;
  public
    class function ErrorStr(Code: Integer): string;
  end;


  { ---------------------------------------------------------------------------------------------- }
  TSQLiteParam = class
  private
    FText: UTF8String;
  public
    Name: string;
    Data: TSQLiteValue;

    constructor Create(Name: string); overload;
    constructor Create(Name: string; Value: Int64); overload;
    constructor Create(Name: string; Value: Double); overload;
    constructor Create(Name: string; Value: WideString); overload;
    constructor Create(Name: string; Value: string); overload;
    constructor Create(Name: string; Value: TStream; Owned: Boolean = False); overload;
    destructor  Destroy; override;

    procedure SetValue(Value: Int64); overload;
    procedure SetValue(Value: Double); overload;
    procedure SetValue(Value: WideString); overload;
    procedure SetValue(Value: string); overload;
    procedure SetValue(Value: TStream); overload;
  end;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteParams = class
  private
    FParams: TStringList;
  protected
    function GetParam(Index: integer): TSQLiteParam;
    function GetNamedParam(Name: string): TSQLiteParam;
  public
    constructor Create; overload; virtual;
    constructor Create(Params: array of const); overload; virtual;
    destructor  Destroy; override;

    procedure Add(Params: array of const); overload; virtual;
    function  Add(Param: TSQLiteParam): integer; overload;
    function  Add(Name: string; Value: integer): integer; overload;
    function  Add(Name: string; Value: integer; NullIf: integer): integer; overload;
    function  Add(Name: string; Value: string): integer; overload;
    function  Add(Name: string; Value: string; NullIf: string): integer; overload;
    function  Add(Name: string; Value: Double): integer; overload;
    function  Add(Name: string; Value: Double; NullIf: Double): integer; overload;
    function  Add(Name: string; Value: TStream; Owned: Boolean = False): integer; overload;
    function  Count: Integer;
    function  IndexOf(Name: string): Integer;
    procedure Delete(Index: Integer);
    function  Remove(Param: TSQLiteParam): Integer;
    procedure Clear;

    property Parameter[Index: integer]: TSQLiteParam  read GetParam; default;
    property Named[Name: string]: TSQLiteParam        read GetNamedParam;
  end;


  { ---------------------------------------------------------------------------------------------- }
  TCustomSQLiteQuery = class abstract
  private
    FParams: TSQLiteParams;
    FOwnsParams: Boolean;
  protected
    FDB: TCustomSQLiteDatabase;
    function GetParams: TSQLiteParams; virtual;
    function GetSQL: string; virtual; abstract;
  public
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams = nil); virtual;
    destructor  Destroy; override;

    property DB: TCustomSQLiteDatabase  read FDB;
    property SQL: string                read GetSQL;
    property Parameters: TSQLiteParams  read GetParams;
  end;


  { ---------------------------------------------------------------------------------------------- }
  TCustomSQLiteField = class abstract
  private
    FColumnDef: TSQLiteColumnDef;
  protected
    function GetColumn: TSQLiteColumnDef;   virtual;
    function GetDataType: TSQLiteDataType;  virtual; abstract;
    function GetIsNull: Boolean;            virtual; abstract;
    function GetAsInteger: Int64;           virtual;
    function GetAsFloat: Double;            virtual;
    function GetAsString: string;           virtual;
    function GetAsStream: TStream;          virtual; abstract;
  public
    constructor Create(Parent: TCustomSQLiteCursor; ColumnIndex: integer); virtual;

    function ReadAsInteger(IfNull: Int64 = 0): Int64;   virtual; abstract;
    function ReadAsFloat(IfNull: Double = 0): Double;   virtual; abstract;
    function ReadAsString(IfNull: string = ''): string; virtual; abstract;

    property Parent: TSQLiteColumnDef   read GetColumn;
    property DataType: TSQLiteDataType  read GetDataType;
    property IsNull: Boolean            read GetIsNull;
    property AsInteger: Int64           read GetAsInteger;
    property AsFloat: Double            read GetAsFloat;
    property AsString: string           read GetAsString;
    property AsStream: TStream          read GetAsStream;
  end;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteRowField = class(TCustomSQLiteField)
  private
    function GetData: PSQLiteValue;
  protected
    function GetDataType: TSQLiteDataType;              override;
    function GetIsNull: Boolean;                        override;
    function GetAsStream: TStream;                      override;
  public
    constructor Create(Parent: TCustomSQLiteCursor; ColumnIndex: integer); override;

    function ReadAsInteger(IfNull: Int64 = 0): Int64;   override;
    function ReadAsFloat(IfNull: Double = 0): Double;   override;
    function ReadAsString(IfNull: string = ''): string; override;
  end;


  { ---------------------------------------------------------------------------------------------- }
  TCustomSQLiteCursor = class abstract
  private
    FOnRowChanged: TNotifyEvent;
  protected
    FDB: TCustomSQLiteDatabase;
    FColumnDefs: TStringList;
    FColumnNames: TStringList;
    FFields: TObjectList;
    FEOF: boolean;
    FRowIndex: integer;

    procedure Initialize(Params: TSQLiteParams); virtual;
    procedure OptimizeColumnDefs; virtual;
    procedure DoRowChanged; virtual;

    function GetColCount: Integer; virtual;
    function GetColumn(Index: integer): TSQLiteColumnDef; virtual;
    function GetField(Index: integer): TCustomSQLiteField; overload; virtual;
    function GetField(Name: string): TCustomSQLiteField; overload; virtual;
  public
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string); overload; virtual;
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Args: array of const); overload; virtual;
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams); overload; virtual;
    constructor Create(Query: TCustomSQLiteQuery); overload; virtual;
    destructor  Destroy; override;

    function FieldIndex(Name: string): integer; virtual;
    function Next: boolean; virtual; abstract;

    property DB: TCustomSQLiteDatabase                  read FDB;
    property ColumnCount: Integer                       read GetColCount;
    property Columns[Index: Integer]: TSQLiteColumnDef  read GetColumn;
    property Fields[Index: Integer]: TCustomSQLiteField read GetField;
    property Field[Name: string]: TCustomSQLiteField    read GetField; default;
    property EOF: Boolean                               read FEOF;
    property RowIndex: Integer                          read FRowIndex;

    property OnRowChanged: TNotifyEvent                 read FOnRowChanged;
  end;


  { ---------------------------------------------------------------------------------------------- }
  // Same as cursor, except this one caches all the data, and is (therefore) not forward-only
  TCustomSQLiteTable = class abstract(TCustomSQLiteCursor)
  private
    FOnRowLoaded: TCountEvent;
  protected
    FRows: TList;
    FBOF: Boolean;
    FCurrentRow: TSQLiteRowData;

    procedure Initialize(Cursor: TCustomSQLiteCursor); reintroduce; virtual;

    function GetField(Index: integer): TCustomSQLiteField; overload; override;
    procedure DoRowChanged; override;
    procedure DoRowLoaded(RowIndex: Integer); virtual;

    function GetRowCount: Int64; virtual;
  public
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams); overload; override;
    constructor Create(Query: TCustomSQLiteQuery); overload; override;
    destructor  Destroy; override;

    function Next: Boolean; override;
    function Previous: Boolean; virtual;

    property BOF: Boolean             read FBOF;
    property DB;
    property ColumnCount;
    property Columns;
    property Fields;
    property EOF;
    property RowCount: Int64          read GetRowCount;
    property RowIndex;

    property OnRowLoaded: TCountEvent read FOnRowLoaded;
  end;


  { ---------------------------------------------------------------------------------------------- }
  TCustomSQLiteDatabase = class abstract
  protected
    FParams: TSQLiteParams;
    FPath: string;
    FFS: TFormatSettings;
  protected
    function  GetIsInTransaction: Boolean;      virtual; abstract;
    function  GetTimeout: Integer;              virtual; abstract;
    procedure SetTimeout(const Value: Integer); virtual; abstract;
    function  GetLocation: string;              virtual;

    function  GetLastInsertRowID: Int64;        virtual;
    function  GetRecentChanges: Int64;          virtual;
    function  GetTotalChanges: Int64;           virtual;
    function  GetVersion: string;               virtual;
  public
    constructor Create(Location: string); overload; virtual;
    constructor Create(Location: string; Flags: Integer); overload; virtual; abstract;
    destructor  Destroy; override;

    function PrepareSQL(SQL: string): TCustomSQLiteQuery; virtual; abstract;
    function Execute(const SQL: string): string; overload; virtual;
    function Execute(const SQL: string; Args: array of const): string; overload; virtual;
    function Execute(const SQL: string; Params: TSQLiteParams): string; overload; virtual; abstract;
    function ExecuteAll(const SQL: string): Int64; overload; virtual;
    function ExecuteAll(const SQL: string; Args: array of const): Int64; overload; virtual;
    function ExecuteAll(SQL: string; Params: TSQLiteParams): Int64; overload; virtual;
    function Execute(Query: TCustomSQLiteQuery): Int64; overload; virtual; abstract;
    function GetCursor(SQL: string): TCustomSQLiteCursor; overload; virtual;
    function GetCursor(SQL: string; Args: array of const): TCustomSQLiteCursor; overload; virtual;
    function GetCursor(SQL: string; Params: TSQLiteParams): TCustomSQLiteCursor; overload; virtual; abstract;
    function GetCursor(Query: TCustomSQLiteQuery): TCustomSQLiteCursor; overload; virtual; abstract;
    function GetTable(SQL: string): TCustomSQLiteTable; overload; virtual;
    function GetTable(SQL: string; Args: array of const): TCustomSQLiteTable; overload; virtual;
    function GetTable(SQL: string; Params: TSQLiteParams): TCustomSQLiteTable; overload; virtual;
    function GetTable(Query: TCustomSQLiteQuery): TCustomSQLiteTable; overload; virtual;
    function GetIntValue(SQL: string; IfNull: Int64 = 0): Int64; overload; virtual;
    function GetIntValue(SQL: string; Args: array of const; IfNull: Int64 = 0): Int64; overload; virtual;
    function GetIntValue(SQL: string; Params: TSQLiteParams; IfNull: Int64 = 0): Int64; overload; virtual;
    function GetStringValue(SQL: string; IfNull: string = ''): string; overload; virtual;
    function GetStringValue(SQL: string; Args: array of const; IfNull: string = ''): string; overload; virtual;
    function GetStringValue(SQL: string; Params: TSQLiteParams; IfNull: string = ''): string; overload; virtual;
    function GetFloatValue(SQL: string; IfNull: Double = 0): Double; overload; virtual;
    function GetFloatValue(SQL: string; Args: array of const; IfNull: Double = 0): Double; overload; virtual;
    function GetFloatValue(SQL: string; Params: TSQLiteParams; IfNull: Double = 0): Double; overload; virtual;

    procedure BeginTransaction; virtual;
    procedure Commit; virtual;
    procedure Rollback; virtual;
    procedure SavePoint(SavepointName: string); overload; virtual;
    procedure SavePoint(SavepointName: string; Args: array of const); overload; virtual;
    procedure Release(SavepointName: string); overload; virtual;
    procedure Release(SavepointName: string; Args: array of const); overload; virtual;
    procedure RollbackTo(SavepointName: string); overload; virtual;
    procedure RollbackTo(SavepointName: string; Args: array of const); overload; virtual;

    function  TableExists(TableName: string): boolean; virtual;
    procedure AttachDatabase(Location, Prefix: string); virtual;
    procedure LoadExtension(Extension: string; EntryPoint: string = ''); virtual;

    property FormatSettings: TFormatSettings  read FFS                  write FFS;
    property Timeout: Integer                 read GetTimeout           write SetTimeout;

    property Location: string                 read GetLocation;
    property Parameters: TSQLiteParams        read FParams;
    property Version: string                  read GetVersion;

    property LastInsertRowID: Int64           read GetLastInsertRowID;
    property RecentChanges: Int64             read GetRecentChanges;
    property TotalChanges: Int64              read GetTotalChanges;
    property IsInTransaction: Boolean         read GetIsInTransaction;
  end;


implementation
uses
  Variants, Windows;


{ ================================================================================================ }
{ TCustomSQLiteCursor }

{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteCursor.Create(DB: TCustomSQLiteDatabase; SQL: string);
begin
  Create(DB, SQL, nil);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteCursor.Create(DB: TCustomSQLiteDatabase; SQL: string; Args: array of const);
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Create(DB, SQL, Params);
  finally
    Params.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteCursor.Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams);
begin
  FDB := DB;
  Initialize(Params);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteCursor.Create(Query: TCustomSQLiteQuery);
begin
  FDB := Query.DB;
  Initialize(Query.Parameters);
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TCustomSQLiteCursor.Destroy;
var
  i: Integer;
begin
  if Assigned(FFields) then begin
    FreeAndNil(FFields);
  end;
  if Assigned(FColumnNames) then
    FreeAndNil(FColumnNames);
  if Assigned(FColumnDefs) then begin
    for i := FColumnDefs.Count - 1 downto 0 do begin
      if Assigned(FColumnDefs.Objects[i]) then
        FColumnDefs.Objects[i].Free;
    end;
    FreeAndNil(FColumnDefs);
  end;
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteCursor.Initialize(Params: TSQLiteParams);
begin
  FEOF := True;
  FRowIndex := -1;
  FColumnDefs := TStringList.Create;
  FColumnDefs.CaseSensitive := False;
  FFields := TObjectList.Create(True);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteCursor.OptimizeColumnDefs;
var
  i: Integer;
  Name: string;
  CharPos: Integer;
  NameIndex: Integer;
begin
  if not Assigned(FColumnNames) then begin
    FColumnNames := TStringList.Create;
    FColumnDefs.CaseSensitive := False;
    FColumnDefs.Duplicates := dupError;
  end;
  for i := 0 to FColumnDefs.Count - 1 do begin
    Name := FColumnDefs[i];
    CharPos := LastDelimiter('.', Name);
    if CharPos = 0 then begin
      NameIndex := FColumnNames.IndexOf(Name);
      if NameIndex = -1 then begin
        FColumnNames.AddObject(Name, TObject(i));
      end else if not SameText(Name, FColumnDefs[integer(FColumnNames.Objects[NameIndex])]) then begin
        FColumnNames.Objects[NameIndex] := TObject(i);
      end;
    end else begin
      Name := Copy(Name, CharPos + 1);
      NameIndex := FColumnNames.IndexOf(Name);
      if NameIndex = -1 then begin
        FColumnNames.AddObject(Name, TObject(i));
      end;
    end;
  end;
end{TCustomSQLiteCursor.OptimizeColumnDefs};


{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteCursor.DoRowChanged;
begin
  if Assigned(FOnRowChanged) then
    FOnRowChanged(Self);
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteCursor.FieldIndex(Name: string): integer;
begin
  if Assigned(FColumnNames) then begin
    Result := FColumnNames.IndexOf(Name);
    if Result <> -1 then
      Result := Integer(FColumnNames.Objects[Result]);
  end else begin
    Result := FColumnDefs.IndexOf(Name);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteCursor.GetColCount: Integer;
begin
  Result := FColumnDefs.Count;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteCursor.GetColumn(Index: integer): TSQLiteColumnDef;
begin
  Result := TSQLiteColumnDef(FColumnDefs.Objects[Index]);
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteCursor.GetField(Name: string): TCustomSQLiteField;
begin
  Result := GetField(FieldIndex(Name));
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteCursor.GetField(Index: integer): TCustomSQLiteField;
begin
  Result := TCustomSQLiteField(FFields[Index]);
end;



{ ================================================================================================ }
{ TCustomSQLiteTable }

{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteTable.Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams);
var
  Cursor: TCustomSQLiteCursor;
begin
  inherited;

  Cursor := FDB.GetCursor(SQL, Params);
  try
    Initialize(Cursor);
  finally
    Cursor.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteTable.Create(Query: TCustomSQLiteQuery);
var
  Cursor: TCustomSQLiteCursor;
begin
  inherited;

  Cursor := FDB.GetCursor(Query);
  try
    Initialize(Cursor);
  finally
    Cursor.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TCustomSQLiteTable.Destroy;
var
  i: Integer;
begin
  if Assigned(FRows) then begin
    for i := FRows.Count - 1 downto 0 do begin
      if Assigned(FRows[i]) then
        TSQLiteRowData(FRows[i]).Free;
    end;
    FreeAndNil(FRows);
  end;
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteTable.Initialize(Cursor: TCustomSQLiteCursor);
var
  i, LoadedRow: Integer;
  ColDef: TSQLiteColumnDef;
  RowData: TSQLiteRowData;
begin
  // Assemble the column metadata
  for i := 0 to Cursor.ColumnCount - 1 do begin
    ColDef := Cursor.Columns[i];
    FColumnDefs.AddObject(ColDef.Name, ColDef.Clone(Self));
    FFields.Add(TSQLiteRowField.Create(Self, i));
  end;
  OptimizeColumnDefs;

  // Retrieve the data rows
  FRows := TList.Create;
  if Cursor.EOF then begin
    FEOF := True;
    FRowIndex := -1;
    FBOF := True;
  end else begin
    FRowIndex := 0;
    LoadedRow := 0;
    while not Cursor.EOF do begin
      RowData := TSQLiteRowData.Create(Self);
      FRows.Add(RowData);
      for i := 0 to Cursor.ColumnCount - 1 do begin
        RowData.CopyValue(i, Cursor.Fields[i]);
      end;
      DoRowLoaded(LoadedRow); // TODO: perhaps only once every x milliseconds?
      Inc(LoadedRow);
      Cursor.Next;
    end;
    FEOF := False;
    FRowIndex := 0;
    FBOF := False;
    DoRowChanged;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteTable.DoRowChanged;
begin
  if not (BOF or EOF) then begin
    FCurrentRow := TSQLiteRowData(FRows[FRowIndex]);
  end else begin
    FCurrentRow := nil;
  end;
  inherited;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteTable.DoRowLoaded(RowIndex: Integer);
begin
  if Assigned(FOnRowLoaded) then
    FOnRowLoaded(Self, RowIndex);
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteTable.GetField(Index: integer): TCustomSQLiteField;
begin
  Result := TCustomSQLiteField(FFields[Index]);
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteTable.GetRowCount: Int64;
begin
  Result := FRows.Count;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteTable.Next: Boolean;
begin
  if FEOF then begin
    raise ESQLiteException.Create(fDB, 'EOF!'); // TODO: make this check generic
  end else if FBOF then begin
    FRowIndex := 0;
    FBOF := False;
  end else if FRowIndex < RowCount - 1 then begin
    Inc(FRowIndex);
  end else begin
    FEOF := True;
    FRowIndex := -1;
  end;
  Result := not FEOF;
  DoRowChanged;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteTable.Previous: Boolean;
begin
  if FBOF then begin
    raise ESQLiteException.Create(fDB, 'BOF!'); // TODO: make this check generic
  end else if FEOF then begin
    FRowIndex := RowCount - 1;
    FEOF := False;
  end else if FRowIndex > 0 then begin
    Dec(FRowIndex);
  end else begin
    FBOF := True;
    FRowIndex := -1;
  end;
  Result := not FBOF;
  DoRowChanged;
end;


{ ------------------------------------------------------------------------------------------------ }
{ TSQLiteColumnDef }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteColumnDef.Create(Cursor: TCustomSQLiteCursor);
begin
  FCursor := Cursor;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteColumnDef.Clone(NewCursor: TCustomSQLiteCursor): TSQLiteColumnDef;
begin
  Result := TSQLiteColumnDef.Create(NewCursor);
  Result.Index := Self.Index;
  Result.Name := Self.Name;
  Result.DataType := Self.DataType;
end;

{ ================================================================================================ }
{ TCustomSQLiteField }

{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteField.Create(Parent: TCustomSQLiteCursor; ColumnIndex: integer);
begin
  FColumnDef := Parent.Columns[ColumnIndex];
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteField.GetColumn: TSQLiteColumnDef;
begin
  Result := FColumnDef;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteField.GetAsFloat: Double;
begin
  Result := ReadAsFloat();
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteField.GetAsInteger: Int64;
begin
  Result := ReadAsInteger();
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteField.GetAsString: string;
begin
  Result := ReadAsString();
end;

{ ================================================================================================ }
{ TSQLiteRowData }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteRowData.Create(Parent: TCustomSQLiteCursor);
begin
  SetLength(FValues, Parent.ColumnCount);
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TSQLiteRowData.Destroy;
var
  i: Integer;
begin
  for i := High(FValues) downto Low(FValues) do begin
    case FValues[i].DataType of
//      dtStr: Dispose(FValues[i].Text); // TODO
      dtBlob: begin
        if Assigned(FValues[i].Blob) then begin
          FreeAndNil(FValues[i].Blob);
        end;
      end;
    end;
  end;
  SetLength(FValues, 0);

  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowData.GetValue(Index: Integer): PSQLiteValue;
begin
  // TODO: verify range
  Result := @FValues[Index];
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteRowData.CopyValue(ColIndex: Integer; SourceField: TCustomSQLiteField);
var
  Data: PSQLiteValue;
begin
  Data := GetValue(ColIndex);
  ZeroMemory(Data, SizeOf(TSQLiteValue));
  Data.DataType := SourceField.DataType;
  case Data.DataType of
    dtInt:      Data.Integer := SourceField.AsInteger;
    dtNumeric:  Data.Float := SourceField.AsFloat;
    dtStr:      Data.Text := PChar(SourceField.AsString);
    dtBlob:     Data.Blob := SourceField.AsStream; // TODO: create a new stream, and copy the contents?
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowData.Clone(Parent: TCustomSQLiteCursor): TSQLiteRowData;
var
  i: Integer;
  SourceVal, TargetVal: PSQLiteValue;
begin
  Result := TSQLiteRowData.Create(Parent);
  for i := 0 to FCursor.ColumnCount - 1 do begin
    SourceVal := Value[i];
    TargetVal := Result.Value[i];
    TargetVal.DataType := SourceVal.DataType;
    case SourceVal.DataType of
      dtInt:      TargetVal.Integer := SourceVal.Integer;
      dtNumeric:  TargetVal.Float := SourceVal.Float;
      dtStr:      TargetVal.Text := PChar(SourceVal.Text);
      dtBlob: begin
        TargetVal.Blob := TMemoryStream.Create;
        SourceVal.Blob.Position := 0;
        TargetVal.Blob.CopyFrom(SourceVal.Blob, SourceVal.Blob.Size);
        SourceVal.Blob.Position := 0;
        TargetVal.Blob.Position := 0;
      end;
    end;
  end;
end{TSQLiteRowData.Clone};


{ ================================================================================================ }
{ TSQLiteRowField }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteRowField.Create(Parent: TCustomSQLiteCursor; ColumnIndex: integer);
begin
  Assert(Parent is TCustomSQLiteTable, 'You cannot use a TSQLiteRowField with a non-table cursor!');
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowField.GetData: PSQLiteValue;
var
  CurrentRow: TSQLiteRowData;
begin
  CurrentRow := TCustomSQLiteTable(FColumnDef.Cursor).FCurrentRow;
  if Assigned(CurrentRow) then begin
    Result := CurrentRow.Value[FColumnDef.Index];
  end else begin
    raise ESQLiteException.Create(FColumnDef.Cursor.DB,
                                  Format('Unable to read field "%s": no current row', [FColumnDef.Name]));
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowField.GetDataType: TSQLiteDataType;
begin
  Result := GetData.DataType;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowField.GetIsNull: Boolean;
begin
  Result := (GetDataType = dtNull);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowField.ReadAsFloat(IfNull: Double): Double;
var
  Value: PSQLiteValue;
begin
  Value := GetData;
  case Value.DataType of
    dtNull:     Result := IfNull;
    dtInt:      Result := Value.Integer;
    dtNumeric:  Result := Value.Float;
    dtStr:      Result := StrToFloatDef(ReadAsString(), IfNull, FColumnDef.Cursor.DB.FormatSettings);
    dtBlob:     raise EConvertError.CreateFmt('Cannot convert field %d from BLOB to float.', [FColumnDef.Index]);
    else        raise EConvertError.CreateFmt('Cannot convert field %d from (type %d) to float.', [FColumnDef.Index, Ord(Value.DataType)]);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowField.ReadAsInteger(IfNull: Int64): Int64;
var
  Value: PSQLiteValue;
begin
  Value := GetData;
  case Value.DataType of
    dtNull:     Result := IfNull;
    dtInt:      Result := Value.Integer;
    dtNumeric:  Result := Round(Value.Float);
    dtStr:      Result := StrToInt64Def(ReadAsString(), IfNull);
    dtBlob:     raise EConvertError.CreateFmt('Cannot convert field %d from BLOB to integer.', [FColumnDef.Index]);
    else        raise EConvertError.CreateFmt('Cannot convert field %d from (type %d) to float.', [FColumnDef.Index, Ord(Value.DataType)]);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowField.GetAsStream: TStream;
var
  Value: PSQLiteValue;
begin
  Value := GetData;
  if Value.DataType = dtBlob then
    Result := Value.Blob
  else if Value.DataType = dtNull then
    Result := nil
  else begin
    raise EConvertError.CreateFmt('Cannot convert field %d to BLOB.', [FColumnDef.Index]);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteRowField.ReadAsString(IfNull: string): string;
var
  Value: PSQLiteValue;
  SS: TStringStream;
begin
  Value := GetData;
  case Value.DataType of
    dtNull:     Result := IfNull;
    dtInt:      Result := IntToStr(Value.Integer);
    dtNumeric:  Result := FloatToStr(Value.Float, FColumnDef.Cursor.DB.FormatSettings);
    dtStr:      Result := string(Value.Text);
    dtBlob:
      begin
        SS := TStringStream.Create;
        try
          Value.Blob.Position := 0;
          SS.CopyFrom(Value.Blob, Value.Blob.Size);
          SS.Position := 0;
          Result := SS.ReadString(SS.Size);
        finally
          SS.Free;
        end;
      end;
  end;
end;


{ ================================================================================================ }
{ ESQLiteException }

{ ------------------------------------------------------------------------------------------------ }
constructor ESQLiteException.Create(DBFile: string; Message: string);
begin
  FDBPath := DBFile;
  inherited Create(Message);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor ESQLiteException.Create(DB: TCustomSQLiteDatabase; Message: string);
begin
  Create(DB, '', Message);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor ESQLiteException.Create(DB: TCustomSQLiteDatabase; SQL: string; Code: Integer);
begin
  Create(DB, SQL, ErrorStr(Code));
end;
{ ------------------------------------------------------------------------------------------------ }
constructor ESQLiteException.Create(DB: TCustomSQLiteDatabase; SQL, Message: string);
begin
  FDBPath := DB.Location;
  FSQL := SQL;
  inherited Create(Message);
end;

{ ------------------------------------------------------------------------------------------------ }
class function ESQLiteException.ErrorStr(Code: Integer): string;
begin
  case Code of
    SQLITE_OK: Result := 'Successful result';
    SQLITE_ERROR: Result := 'SQL error or missing database';
    SQLITE_INTERNAL: Result := 'An internal logic error in SQLite';
    SQLITE_PERM: Result := 'Access permission denied';
    SQLITE_ABORT: Result := 'Callback routine requested an abort';
    SQLITE_BUSY: Result := 'The database file is locked';
    SQLITE_LOCKED: Result := 'A table in the database is locked';
    SQLITE_NOMEM: Result := 'A malloc() failed';
    SQLITE_READONLY: Result := 'Attempt to write a readonly database';
    SQLITE_INTERRUPT: Result := 'Operation terminated by sqlite3_interrupt()';
    SQLITE_IOERR: Result := 'Some kind of disk I/O error occurred';
    SQLITE_CORRUPT: Result := 'The database disk image is malformed';
    SQLITE_NOTFOUND: Result := '(Internal Only) Table or record not found';
    SQLITE_FULL: Result := 'Insertion failed because database is full';
    SQLITE_CANTOPEN: Result := 'Unable to open the database file';
    SQLITE_PROTOCOL: Result := 'Database lock protocol error';
    SQLITE_EMPTY: Result := 'Database is empty';
    SQLITE_SCHEMA: Result := 'The database schema changed';
    SQLITE_TOOBIG: Result := 'Too much data for one row of a table';
    SQLITE_CONSTRAINT: Result := 'Abort due to contraint violation';
    SQLITE_MISMATCH: Result := 'Data type mismatch';
    SQLITE_MISUSE: Result := 'Library used incorrectly';
    SQLITE_NOLFS: Result := 'Uses OS features not supported on host';
    SQLITE_AUTH: Result := 'Authorization denied';
    SQLITE_FORMAT: Result := 'Auxiliary database format error';
    SQLITE_RANGE: Result := '2nd parameter to sqlite3_bind out of range';
    SQLITE_NOTADB: Result := 'File opened that is not a database file';
    SQLITE_ROW: Result := 'sqlite3_step() has another row ready';
    SQLITE_DONE: Result := 'sqlite3_step() has finished executing';
  else
    Result := 'Unknown SQLite Error Code "' + IntToStr(Code) + '"';
  end;
end;




{ ------------------------------------------------------------------------------------------------ }
{ TSQLiteParam }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParam.Create(Name: string);
begin
  Self.Name := Name;
  SetValue(nil);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParam.Create(Name: string; Value: double);
begin
  Self.Name := Name;
  SetValue(Value);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParam.Create(Name: string; Value: int64);
begin
  Self.Name := Name;
  SetValue(Value);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParam.Create(Name: string; Value: WideString);
begin
  Self.Name := Name;
  SetValue(Value);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParam.Create(Name: string; Value: TStream; Owned: Boolean);
begin
  Self.Name := Name;
  SetValue(Value);
  Data.OwnsBlob := Owned;
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParam.Create(Name: string; Value: string);
begin
  Self.Name := Name;
  SetValue(Value);
end;

{ ------------------------------------------------------------------------------------------------ }
destructor TSQLiteParam.Destroy;
begin
  if (Data.DataType = dtBlob) and Assigned(Data.Blob) and Data.OwnsBlob then
    FreeAndNil(Data.Blob);

  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParam.SetValue(Value: double);
begin
  Data.Float := Value;
  Data.DataType := dtNumeric;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParam.SetValue(Value: int64);
begin
  Data.Integer := Value;
  Data.DataType := dtInt;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParam.SetValue(Value: TStream);
begin
  // TODO: Clear first (Clear should check for datatype blob, if so, ownership, and free the blob if necessary)
  // TODO: apply Clear in every SetValue
  Data.Blob := Value;
  if Assigned(Value) then begin
    Data.DataType := dtBlob;
    Data.OwnsBlob := False;
  end else begin
    Data.DataType := dtNull;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParam.SetValue(Value: string);
begin
//{$IFDEF UNICODE}
//  FText := UTF8String(Value);
//{$ELSE}
//  FText := AnsiToUtf8(Value);
//{$ENDIF}
  Data.Text := PChar(Value);
  Data.DataType := dtStr;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParam.SetValue(Value: WideString);
begin
//  FText := UTF8Encode(Value);
  Data.Text := PChar(string(FText));
  Data.DataType := dtStr;
end;


{ ================================================================================================ }
{ TSQLiteParams }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParams.Create;
begin
  inherited;
  FParams := TStringList.Create(True);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteParams.Create(Params: array of const);
begin
  Create;
  Add(Params);
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TSQLiteParams.Destroy;
begin
  Clear;
  FreeAndNil(FParams);

  inherited;
end;


{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Param: TSQLiteParam): integer;
begin
  if Param.Name = '' then begin
    Result := FParams.AddObject(Param.Name, Param);
  end else begin
    Result := FParams.IndexOf(Param.Name);
    if Result = -1 then begin
      Result := FParams.AddObject(Param.Name, Param);
    end else begin
      GetParam(Result).Free;
      FParams.Objects[Result] := Param;
      FParams[Result] := Param.Name;
    end;
  end;
end{TSQLiteParams.Add};
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Name, Value: string): integer;
begin
  Result := Add(TSQLiteParam.Create(Name, Value));
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Name, Value, NullIf: string): integer;
begin
  if Value <> NullIf then
    Result := Add(TSQLiteParam.Create(Name, Value))
  else
    Result := Add(TSQLiteParam.Create(Name, nil));
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Name: string; Value, NullIf: integer): integer;
begin
  if Value <> NullIf then
    Result := Add(TSQLiteParam.Create(Name, Value))
  else
    Result := Add(TSQLiteParam.Create(Name, nil));
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Name: string; Value: integer): integer;
begin
  Result := Add(TSQLiteParam.Create(Name, Value));
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Name: string; Value: Double): integer;
begin
  Result := Add(TSQLiteParam.Create(Name, Value));
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Name: string; Value: TStream; Owned: Boolean): integer;
begin
  Result := Add(TSQLiteParam.Create(Name, Value, Owned));
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Add(Name: string; Value, NullIf: Double): integer;
begin
  if Value <> NullIf then
    Result := Add(TSQLiteParam.Create(Name, Value))
  else
    Result := Add(TSQLiteParam.Create(Name, nil));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParams.Add(Params: array of const);
var
  i: Integer;
  V: Variant;
  tmpInt: Int64;
  tmpDbl: Double;
  tmpString: string;
begin
  for i := Low(Params) to High(Params) do begin
    case Params[i].VType of
      vtInteger:        Add('', Params[i].VInteger);
      vtBoolean:        Add('', Integer(Params[i].VBoolean));
      vtChar:           Add('', string(Params[i].VChar));
      vtExtended:       Add('', Params[i].VExtended^);
      vtString:         Add('', string(Params[i].VString^));
      vtPChar:          Add('', string(Params[i].VPChar));
      vtObject:         Add('', Params[i].VObject as TStream);
      vtWideChar:       Add('', widestring(Params[i].VWideChar));
      vtPWideChar:      Add('', WideString(Params[i].VPWideChar));
      vtAnsiString:     Add('', Params[i].VAnsiString);
      vtCurrency:       Add('', Double(Params[i].VCurrency^));
      vtVariant: begin
        V := Params[i].VVariant^;
        case VarType(V) and not varByRef of
          varEmpty, varNull: Add('', nil);
          varSmallint, varInteger, varShortInt, varByte, varWord, varLongWord, varInt64, varUInt64, varBoolean: begin
                        tmpInt := V;
                        Add('', tmpInt);
          end;
          varSingle, varDouble, varCurrency: begin
                        tmpDbl := V;
                        Add('', tmpDbl);
          end;
          varOleStr, varString, varUString: begin
                        tmpString := V;
                        Add('', tmpString);
          end
          else        raise EConvertError.CreateFmt('Data type not supported! (VarType %d)', [VarType(Params[i].VVariant^)]);
        end;
      end;
      vtWideString:     Add('', WideString(Params[i].VWideString));
      vtInt64:          Add('', Params[i].VInt64^);
{$IFDEF UNICODE}
      vtUnicodeString:  Add('', string(Params[i].VUnicodeString));
{$ENDIF}
      else              raise EConvertError.CreateFmt('Data type not supported! (VType %d)', [Params[i].VType]);
    end;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParams.Delete(Index: Integer);
begin
  GetParam(Index).Free;
  FParams.Delete(Index);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteParams.Clear;
begin
  FParams.Clear;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Count: Integer;
begin
  Result := FParams.Count;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.GetNamedParam(Name: string): TSQLiteParam;
var
  Index: Integer;
begin
  Index := FParams.IndexOf(Name);
  if Index <> -1 then
    Result := GetParam(Index)
  else
    Result := nil;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.GetParam(Index: integer): TSQLiteParam;
begin
  Result := TSQLiteParam(FParams.Objects[Index]);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.IndexOf(Name: string): Integer;
begin
  Result := FParams.IndexOf(Name);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteParams.Remove(Param: TSQLiteParam): Integer;
begin
  Result := FParams.IndexOfObject(Param);
  if Result <> -1 then
    Delete(Result);
end;


{ ================================================================================================ }
{ TCustomSQLiteQuery }

{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteQuery.Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams = nil);
begin
  FDB := DB;
  FParams := Params;
  FOwnsParams := False;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TCustomSQLiteQuery.Destroy;
begin
  if FOwnsParams and Assigned(FParams) then
    FreeAndNil(FParams);
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteQuery.GetParams: TSQLiteParams;
begin
  if not Assigned(FParams) then begin
    FParams := TSQLiteParams.Create;
    FOwnsParams := True;
  end;
  Result := FParams;
end;

{ ================================================================================================ }
{ TCustomSQLiteDatabase }

{ ------------------------------------------------------------------------------------------------ }
constructor TCustomSQLiteDatabase.Create(Location: string);
begin
  FParams := TSQLiteParams.Create;
  FFS.DateSeparator := '-';
  FFS.TimeSeparator := ':';
  FFS.LongDateFormat := 'yyyy-MM-dd';
  FFS.ShortDateFormat := 'yyyy-MM-dd';
  FFS.LongTimeFormat := 'hh:nn:ss';
  FFS.ShortTimeFormat := 'hh:nn:ss';
  FPath := Location;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TCustomSQLiteDatabase.Destroy;
begin
  FreeAndNil(FParams);
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.Execute(const SQL: string): string;
begin
  Result := Execute(SQL, Parameters);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.Execute(const SQL: string; Args: array of const): string;
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Result := Execute(SQL, Params);
  finally
    Params.Free;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.ExecuteAll(const SQL: string): Int64;
begin
  Result := ExecuteAll(SQL, nil);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.ExecuteAll(const SQL: string; Args: array of const): Int64;
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Result := ExecuteAll(SQL, Params);
  finally
    Params.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.ExecuteAll(SQL: string; Params: TSQLiteParams): Int64;
begin
  Result := 0;
  repeat
    SQL := Copy(Execute(SQL, Params), 1);
    Inc(Result, RecentChanges);
  until SQL = '';
end;




{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetLocation: string;
begin
  Result := FPath;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetCursor(SQL: string): TCustomSQLiteCursor;
begin
  Result := GetCursor(SQL, nil);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetCursor(SQL: string; Args: array of const): TCustomSQLiteCursor;
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Result := GetCursor(SQL, Params);
  finally
    Params.Free;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetTable(SQL: string): TCustomSQLiteTable;
begin
  Result := GetTable(SQL, nil);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetTable(SQL: string; Args: array of const): TCustomSQLiteTable;
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Result := GetTable(SQL, Params);
  finally
    Params.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetTable(SQL: string; Params: TSQLiteParams): TCustomSQLiteTable;
begin
  Result := TCustomSQLiteTable.Create(Self, SQL, Params);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetTable(Query: TCustomSQLiteQuery): TCustomSQLiteTable;
begin
  Result := TCustomSQLiteTable.Create(Query);
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetFloatValue(SQL: string; IfNull: Double): Double;
begin
  Result := GetFloatValue(SQL, nil, IfNull);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetFloatValue(SQL: string; Args: array of const; IfNull: Double): Double;
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Result := GetFloatValue(SQL, Params, IfNull);
  finally
    Params.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetFloatValue(SQL: string; Params: TSQLiteParams; IfNull: Double): Double;
var
  Cursor: TCustomSQLiteCursor;
begin
  Cursor := GetCursor(SQL, Params);
  try
    if Cursor.EOF or (Cursor.ColumnCount = 0) then
      Result := IfNull
    else
      Result := Cursor.Fields[0].ReadAsFloat(IfNull);
  finally
    Cursor.Free;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetIntValue(SQL: string; IfNull: Int64): Int64;
begin
  Result := GetIntValue(SQL, nil, IfNull);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetIntValue(SQL: string; Args: array of const; IfNull: Int64): Int64;
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Result := GetIntValue(SQL, Params, IfNull);
  finally
    Params.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetIntValue(SQL: string; Params: TSQLiteParams; IfNull: Int64): Int64;
var
  Cursor: TCustomSQLiteCursor;
begin
  Cursor := GetCursor(SQL, Params);
  try
    if Cursor.EOF or (Cursor.ColumnCount = 0) then
      Result := IfNull
    else
      Result := Cursor.Fields[0].ReadAsInteger(IfNull);
  finally
    Cursor.Free;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetStringValue(SQL, IfNull: string): string;
begin
  Result := GetStringValue(SQL, nil, IfNull);
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetStringValue(SQL: string; Args: array of const; IfNull: string): string;
var
  Params: TSQLiteParams;
begin
  Params := TSQLiteParams.Create(Args);
  try
    Result := GetStringValue(SQL, Params, IfNull);
  finally
    Params.Free;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetStringValue(SQL: string; Params: TSQLiteParams; IfNull: string): string;
var
  Cursor: TCustomSQLiteCursor;
begin
  Cursor := GetCursor(SQL, Params);
  try
    if Cursor.EOF or (Cursor.ColumnCount = 0) then
      Result := IfNull
    else
      Result := Cursor.Fields[0].ReadAsString(IfNull);
  finally
    Cursor.Free;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetLastInsertRowID: Int64;
begin
  Result := GetIntValue('SELECT last_insert_rowid();')
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetRecentChanges: Int64;
begin
  Result := GetIntValue('SELECT changes();')
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetTotalChanges: Int64;
begin
  Result := GetIntValue('SELECT total_changes();')
end;

{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.GetVersion: string;
begin
  Result := GetStringValue('SELECT sqlite_version();');
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.LoadExtension(Extension, EntryPoint: string);
begin
  FParams.Clear;
  FParams.Add(':Extension', Extension);
  if EntryPoint = '' then begin
    Execute('SELECT load_extension(:Extension);');
  end else begin
    FParams.Add(':EntryPoint', EntryPoint);
    Execute('SELECT load_extension(:Extension, :EntryPoint);');
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.AttachDatabase(Location, Prefix: string);
begin
  // If the provided location is relative, then prepend the main database's path
  if not ((Location[1] = PathDelim) or (Location[2] = ':')) then begin
    Location := IncludeTrailingPathDelimiter(ExtractFilePath(FPath)) + Location;
  end;
  Parameters.Add(':Location', Location);
  Parameters.Add(':Prefix', Prefix);
  Execute('ATTACH DATABASE :Location AS :Prefix');
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.BeginTransaction;
begin
  Execute('BEGIN TRANSACTION');
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.Commit;
begin
  Execute('COMMIT');
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.Rollback;
begin
  Execute('ROLLBACK');
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.SavePoint(SavepointName: string; Args: array of const);
begin
  SavePoint(Format(SavepointName, Args));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.SavePoint(SavepointName: string);
begin
  Execute('SAVEPOINT ''' + StringReplace(SavepointName, '''', '''''', [rfReplaceAll]) + '''');
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.Release(SavepointName: string; Args: array of const);
begin
  Release(Format(SavepointName, Args));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.Release(SavepointName: string);
begin
  Execute('RELEASE ''' + StringReplace(SavepointName, '''', '''''', [rfReplaceAll]) + '''');
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.RollbackTo(SavepointName: string; Args: array of const);
begin
  RollbackTo(Format(SavepointName, Args));
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TCustomSQLiteDatabase.RollbackTo(SavepointName: string);
begin
  Execute('ROLLBACK TO ''' + StringReplace(SavepointName, '''', '''''', [rfReplaceAll]) + '''');
end;


{ ------------------------------------------------------------------------------------------------ }
function TCustomSQLiteDatabase.TableExists(TableName: string): boolean;
var
  Separator: integer;
  Cursor: TCustomSQLiteCursor;
  Repository, Prefix, SQL: string;
begin
  Repository := 'sqlite_master';
  Separator := Pos('.', TableName);
  if Separator > 0 then begin
    // first, check if the attached database exists
    Prefix := Copy(TableName, 1, Separator - 1);
    TableName := Copy(TableName, Separator + 1);
    if SameText(Prefix, 'temp') then begin
      Prefix := '';
      Repository := 'sqlite_temp_master';
    end else begin
      Cursor := GetCursor('PRAGMA database_list');
      try
        Result := False;
        while not Cursor.EOF do begin
          if LowerCase(Cursor.Field['name'].AsString) = LowerCase(Prefix) then begin
            Result := True;
            Break;
          end;
          Cursor.Next;
        end;
      finally
        Cursor.Free;
      end;
      if Result = False then begin
        Exit;
      end;
      Repository := Prefix + '.' + Repository;
    end;
  end else begin
    Prefix := '';
  end;
  // Returns true if table exists in the database
  SQL := 'SELECT count(*) FROM ' + Repository + ' WHERE [type] = ''table'' AND lower(name) = :TableName';
  Result := (0 < GetIntValue(SQL, [LowerCase(TableName)], 0));
end;

end.

Added src/lib/SQLite3Database.pas.





























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
unit SQLite3Database;

interface
uses
  Classes,
  SQLite3, SQLite3Abstract, SQLite3Functions;

type
  { ---------------------------------------------------------------------------------------------- }
  // Local database; interfaces with SQLite3.DLL
  TSQLiteDatabase = class(TCustomSQLiteDatabase)
  private
    FDBHandle: TSQLiteDB;
    FTimeout: Integer;
    FFunctionList: TStringList;
    FQueries: TList;
  protected
    procedure BindParams(Stmt: TSQLiteStmt; Params: TSQLiteParams);
    procedure RaiseError(SQL: string; Code: Integer = -1);

    function  GetIsInTransaction: Boolean;      override;
    function  GetTimeout: Integer;              override;
    procedure SetTimeout(const Value: Integer); override;
    function  GetLastInsertRowID: Int64;        override;
    function  GetRecentChanges: Int64;          override;
    function  GetTotalChanges: Int64;           override;
    function  GetVersion: string;               override;
  public
    constructor Create(Location: string); override;
    constructor Create(Location: string; Flags: Integer); override;
    destructor  Destroy; override;

    function PrepareSQL(SQL: string): TCustomSQLiteQuery; override;
    function Execute(const SQL: string; Params: TSQLiteParams): string; overload; override;
    function Execute(Query: TCustomSQLiteQuery): Int64; overload; override;
    function GetCursor(SQL: string; Params: TSQLiteParams): TCustomSQLiteCursor; overload; override;
    function GetCursor(Query: TCustomSQLiteQuery): TCustomSQLiteCursor; overload; override;
    function GetTable(SQL: string; Params: TSQLiteParams): TCustomSQLiteTable; overload; override;
    function GetTable(Query: TCustomSQLiteQuery): TCustomSQLiteTable; overload; override;

    procedure AddSystemCollate;
    procedure AddCustomCollate(name: string; xCompare: TCollateXCompare; Data: Pointer = nil);

    procedure AddFunction(Name: string; ParamCount: integer; Handler: TSQLiteUserFunction; Data: TObject); overload;
    procedure AddFunction(Name: string; ParamCount: integer; Step, Final: TSQLiteUserFunction; Data: TObject); overload;
    procedure RemoveFunction(Name: string; ParamCount: integer);


    procedure LoadExtension(Extension: string; EntryPoint: string = ''); override;

    property Handle: TSQLiteDB    read FDBHandle;
  end;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteTable = class(TCustomSQLiteTable)
    // TODO: moet hier nog iets aan toegevoegd worden voor een tabel uit een lokale database?
  end;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteQuery = class(TCustomSQLiteQuery)
  protected
    FQueryHandle: TSqliteStmt;
    function GetSQL: string; override;
  public
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams = nil); override;
    destructor  Destroy; override;

    property Handle: TSQLiteStmt  read FQueryHandle;
  end;

  { ---------------------------------------------------------------------------------------------- }
  TSQLiteField = class(TCustomSQLiteField)
  protected
    FQueryHandle: TSQLiteStmt;
    FColumnIndex: Integer;

    function GetDataType: TSQLiteDataType;              override;
    function GetIsNull: Boolean;                        override;
    function GetAsInteger: Int64;                       override;
    function GetAsFloat: Double;                        override;
    function GetAsStream: TStream;                      override;
  public
    constructor Create(Parent: TCustomSQLiteCursor; ColumnIndex: integer); override;

    function ReadAsInteger(IfNull: Int64 = 0): Int64;   override;
    function ReadAsFloat(IfNull: Double = 0): Double;   override;
    function ReadAsString(IfNull: string = ''): string; override;
  end;

  { ---------------------------------------------------------------------------------------------- }
  // local database, interfaces with SQLite3.DLL
  TSQLiteCursor = class(TCustomSQLiteCursor)
  protected
    FQuery: TSQLiteQuery;
    FOwnsQuery: boolean;

    FDBHandle: TSQLiteDB;
    FQueryHandle: TSQLiteStmt;

    procedure DetermineColumns; virtual;
  public
    constructor Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams); overload; override;
    constructor Create(Query: TCustomSQLiteQuery); overload; override;
    destructor  Destroy; override;

    function Next: boolean; override;

    property Handle: TSQLiteStmt  read FQueryHandle;
  end;


{ ------------------------------------------------------------------------------------------------ }
procedure DisposeProc(Ptr: pointer); cdecl;

////////////////////////////////////////////////////////////////////////////////////////////////////
implementation

uses
  SysUtils, Windows;

{ ------------------------------------------------------------------------------------------------ }
procedure DisposeProc(Ptr: pointer); cdecl;
begin
  if Assigned(Ptr) then
    Freemem(Ptr);
end;


{ ================================================================================================ }
{ TSQLiteDatabase }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteDatabase.Create(Location: string);
var
  Filename: UTF8String;
  Code: Integer;
  Msg: PAnsiChar;
begin
  inherited;

  FFunctionList := TStringList.Create;
  FFunctionList.CaseSensitive := False;
  FFunctionList.Duplicates := dupAccept;

  FQueries := TList.Create;

  Msg := nil;
  try
    Filename := UTF8String(Location);
    Code := SQLite3_Open(PAnsiChar(FileName), FDBHandle);

    if Code <> SQLITE_OK then
      if Assigned(FDBHandle) then begin
        Msg := Sqlite3_ErrMsg(FDBHandle);
        raise ESqliteException.Create(Location, Format('Failed to open database "%s" : %s',
                                                      [FileName, PUTF8CharToString(Msg)]));
      end else begin
        raise ESqliteException.Create(Location, Format('Failed to open database "%s" : %s',
                                                      [FileName, SQLiteErrorStr(Code)]));
      end;

//set a few configs
//L.G. Do not call it here. Because busy handler has not been set here,
// any share violation causing exception!

//    self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;');
//    self.ExecSQL('PRAGMA temp_store = MEMORY;');

  finally
    if Assigned(Msg) then
      SQLite3_Free(Msg);
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteDatabase.Create(Location: string; Flags: Integer);
var
  Filename: UTF8String;
  Code: Integer;
  Msg: PAnsiChar;
begin
  inherited;

  FQueries := TList.Create;

  Msg := nil;
  try
    Filename := UTF8String(Location);
    Code := SQLite3_Open_v2(PAnsiChar(FileName), FDBHandle, Flags, nil);

    if Code <> SQLITE_OK then
      if Assigned(FDBHandle) then begin
        Msg := Sqlite3_ErrMsg(FDBHandle);
        raise ESqliteException.Create(Location, Format('Failed to open database "%s" : %s',
                                                      [FileName, PUTF8CharToString(Msg)]));
      end else begin
        raise ESqliteException.Create(Location, Format('Failed to open database "%s" : %s',
                                                      [FileName, SQLiteErrorStr(Code)]));
      end;

//set a few configs
//L.G. Do not call it here. Because busy handler has not been set here,
// any share violation causing exception!

//    self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;');
//    self.ExecSQL('PRAGMA temp_store = MEMORY;');

  finally
    if Assigned(Msg) then
      SQLite3_Free(Msg);
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TSQLiteDatabase.Destroy;
var
  Code: integer;
  i: Integer;
begin
   if FQueries.Count > 0 then begin
    // Make certain all the queries on this database are being released
    for i := FQueries.Count - 1 downto 0 do begin
      (TObject(FQueries[i]) as TSQLiteQuery).Free;
    end;
  end;
  FreeAndNil(FQueries);

  for i := FFunctionList.Count - 1 downto 0 do begin
    FFunctionList.Objects[i].Free;
  end;
  FFunctionList.Free;

  if Assigned(FDBHandle) then begin
    Code := SQLite3_Close(FDBHandle);
    {--- MCO 15-10-2010: Ik zet hier een assertion neer; bij het debuggen treedt de fout dan op;
                          maar in het definitieve product wordt de fout stilletjes verzwegen. ---}
    Assert(Code = SQLITE_OK, SQLiteErrorStr(Code));
  end;

  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.RaiseError(SQL: string; Code: Integer);
var
  ErrMsg: PAnsiChar;
  Msg: string;
begin
  if (Code = -1) and Assigned(FDBHandle) then begin
    Code := SQLite3_ErrCode(FDBHandle)
  end;

  ErrMsg := SQLite3_ErrMsg(FDBHandle);
  if Assigned(ErrMsg) then
    Msg := Copy(PUTF8CharToString(ErrMsg), 1)
  else
    Msg := SQLiteErrorStr(Code);

  raise ESQLiteException.Create(Self, SQL, Msg);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.PrepareSQL(SQL: string): TCustomSQLiteQuery;
begin
  Result := TSQLiteQuery.Create(Self, SQL);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.Execute(const SQL: string; Params: TSQLiteParams): string;
var
  SQL8: UTF8String;
  ThisSQLStatement, NextSQLStatement: PAnsiChar;
  Code: Integer;
  Stmt: TSQLiteStmt;
  ParsedSQL: string;
begin
  try
{$IFDEF UNICODE}
    SQL8 := UTF8String(SQL);
    ThisSQLStatement := PAnsiChar(SQL8); // StringToPUTF8Char(SQL);
{$ELSE}
    SQL8 := AnsiToUtf8(SQL);
    ThisSQLStatement := PAnsiChar(SQL8);
{$ENDIF}

    Code := Sqlite3_Prepare_v2(FDBHandle, ThisSQLStatement, -1, Stmt, NextSQLStatement);
    if Code <> SQLITE_OK then begin
      RaiseError(SQL, Code);
    end;
    if (Stmt = nil) then begin
      Code := SQLite3_ErrCode(FDBHandle);
      if Code <> SQLITE_OK then begin
        RaiseError(SQL, Code);
      end else begin
        Result := '';
        Exit;
      end;
    end;

    // Bind values to SQLite3 statement
    BindParams(Stmt, Params);

    Code := Sqlite3_step(Stmt);
    if not (Code in [SQLITE_DONE, SQLITE_ROW]) then begin
      ParsedSQL := PUTF8CharToString(SQLite3_SQL(stmt));
      if ParsedSQL = '' then ParsedSQL := SQL;
      SQLite3_reset(stmt);
      RaiseError(ParsedSQL, Code);
    end;

    Result := PUTF8CharToString(NextSQLStatement);
  finally
    if Assigned(Stmt) then begin
      Sqlite3_Finalize(stmt);
    end;
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.Execute(Query: TCustomSQLiteQuery): Int64;
var
  Code: Integer;
  Stmt: TSQLiteStmt;
begin
  Stmt := (Query as TSQLiteQuery).Handle;

  // Bind values to SQLite3 statement
  BindParams(Stmt, Query.Parameters);

  Code := Sqlite3_step(Stmt);
  if (Code <> SQLITE_DONE) then begin
    SQLite3_reset(stmt);
    RaiseError(Query.SQL, Code);
  end;

  // Return the number of affected rows
  Result := RecentChanges;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.BindParams(Stmt: TSQLiteStmt; Params: TSQLiteParams);
var
  Code: Integer;
  i, Index: Integer;
  Param: TSQLiteParam;
  BlobSize: Int64;
  Ptr: Pointer;
begin
  if Assigned(Stmt) then begin
    Code := SQLite3_Reset(Stmt);
    Assert(Code = SQLITE_OK, 'Could not reset statement: ' + SQLiteErrorStr(Code));
    Code := SQLite3_clear_bindings(Stmt);
    Assert(Code = SQLITE_OK, 'Could not clear bindings: ' + SQLiteErrorStr(Code));

    if Assigned(Params) then begin
      for i := 0 to Params.Count - 1 do begin
        Param := Params[i];
        if Param.Name = '' then begin
          Index := i + 1;
        end else begin
          Index := sqlite3_bind_parameter_index(Stmt, StringToPUTF8Char(Param.Name));
        end;
        if (Index > 0) and (Index <= sqlite3_bind_parameter_count(Stmt)) then begin
          case Param.Data.DataType of
            dtInt:      Code := sqlite3_bind_int64(Stmt, Index, Param.Data.Integer);
            dtNumeric:  Code := sqlite3_bind_double(Stmt, Index, Param.Data.Float);
            dtStr:      Code := sqlite3_bind_text(Stmt, Index,
                                                  StringToPUTF8Char(string(Param.Data.Text)), -1,
                                                  SQLITE_TRANSIENT); // TODO: could this be SQLITE_STATIC?
            dtBlob:     begin
              if Assigned(Param.Data.Blob) then begin
                //now bind the blob data
                BlobSize := Param.Data.Blob.Size;
                if BlobSize > 0 then begin
                  GetMem(Ptr, BlobSize);
                  if (ptr = nil) then begin
                    raise ESqliteException.Create(Self, Format('Error getting memory to save blob (%s)',
                                                               [Param.Name]));
                  end;
                  Param.Data.Blob.Position := 0;
                  Param.Data.Blob.Read(Ptr^, BlobSize);
                  Code := SQLite3_bind_blob(Stmt, Index, Ptr, BlobSize, @DisposeProc);
                end else begin
                  Code := SQLite3_bind_blob(Stmt, Index, Param.Data.Blob, 0, SQLITE_STATIC);
                end;
              end else begin
                Code := sqlite3_bind_null(Stmt, Index);
              end{if};
            end;
            else begin
              Code := sqlite3_bind_null(Stmt, Index);
            end;
          end{case};
          if Code <> SQLITE_OK then begin
            raise ESQLiteException.Create(Self, Format('Error binding parameter %s to statement', [Param.Name]));
          end;
        end{if};
      end{for};
    end{if};
  end;
end{TSQLiteDatabase.BindParams};

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetCursor(SQL: string; Params: TSQLiteParams): TCustomSQLiteCursor;
begin
  Result := TSQLiteCursor.Create(Self, SQL, Params);
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetCursor(Query: TCustomSQLiteQuery): TCustomSQLiteCursor;
begin
  Result := TSQLiteCursor.Create(Query);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetTable(SQL: string; Params: TSQLiteParams): TCustomSQLiteTable;
begin
  Result := TSQLiteTable.Create(Self, SQL, Params);
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetTable(Query: TCustomSQLiteQuery): TCustomSQLiteTable;
begin
  Result := TSQLiteTable.Create(Query);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetIsInTransaction: Boolean;
begin
  Result := SQLite3_Get_Autocommit(FDBHandle) = 0;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.SetTimeout(const Value: Integer);
begin
  SQLite3_BusyTimeout(FDBHandle, Value);
  FTimeout := Value;
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetTimeout: Integer;
begin
  Result := FTimeout;
end;

{ ------------------------------------------------------------------------------------------------ }
function SystemCollate(Userdta: pointer; Buf1Len: integer; Buf1: pointer;
    Buf2Len: integer; Buf2: pointer): integer; cdecl;
begin
  Result := CompareStringW(LOCALE_USER_DEFAULT, 0, PWideChar(Buf1), Buf1Len,
    PWideChar(Buf2), Buf2Len) - 2;
end;
{ ------------------------------------------------------------------------------------------------ }
function SystemCollateNocase(Userdta: pointer; Buf1Len: integer; Buf1: pointer;
    Buf2Len: integer; Buf2: pointer): integer; cdecl;
begin
  Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PWideChar(Buf1), Buf1Len,
    PWideChar(Buf2), Buf2Len) - 2;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.AddSystemCollate;
var
  Code: Integer;
begin
  // Adds collate named SYSTEM for correct data sorting by user's locale
  Code := sqlite3_create_collation(FDBHandle, 'SYSTEM', SQLITE_UTF16LE, nil, @SystemCollate);
  Assert(Code = SQLITE_OK, 'Failed to add SYSTEM collation');
  Code := sqlite3_create_collation(FDBHandle, 'NOCASE', SQLITE_UTF16LE, nil, @SystemCollateNocase);
  Assert(Code = SQLITE_OK, 'Failed to add SYSTEM NOCASE collation');
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.AddCustomCollate(Name: string; xCompare: TCollateXCompare; Data: Pointer = nil);
var
  Code: Integer;
begin
  Code := sqlite3_create_collation(FDBHandle, StringToPUTF8Char(Name), SQLITE_UTF8, Data, xCompare);
  Assert(Code = SQLITE_OK, 'Failed to add custom collation');
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.AddFunction(Name: string; ParamCount: integer; Handler: TSQLiteUserFunction; Data: TObject);
var
  SFI: TSQLiteFunctionInterface;
begin
  SFI := TSQLiteFunctionInterface.Create(Self, Name, ParamCount, Data, Handler);
  FFunctionList.AddObject(Name + ' ' + IntToStr(ParamCount), SFI);
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.AddFunction(Name: string; ParamCount: integer; Step, Final: TSQLiteUserFunction; Data: TObject);
var
  SFI: TSQLiteFunctionInterface;
begin
  SFI := TSQLiteFunctionInterface.Create(Self, Name, ParamCount, Data, Step, Final);
  FFunctionList.AddObject(Name + ' ' + IntToStr(ParamCount), SFI);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.RemoveFunction(Name: string; ParamCount: integer);
var
  Index: Integer;
begin
  Index := FFunctionList.IndexOf(Name + ' ' + IntToStr(ParamCount));
  if Index > -1 then begin
    // Destroying the TSQLiteFunctionInterface will unregister it from the database
    TSQLiteFunctionInterface(FFunctionList[Index]).Free;
    FFunctionList.Delete(Index);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetLastInsertRowID: Int64;
begin
  Result := SQLite3_LastInsertRowID(FDBHandle);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetRecentChanges: Int64;
begin
  Result := SQLite3_Changes(FDBHandle);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetTotalChanges: Int64;
begin
  Result := SQLite3_TotalChanges(FDBHandle);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteDatabase.GetVersion: string;
begin
  Result := PUTF8CharToString(SQLite3_Version());
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteDatabase.LoadExtension(Extension, EntryPoint: string);
var
  ExtPath, ExtEntryPoint, ExtErrMsg: PAnsiChar;
  Code: Integer;
  ErrMsg: string;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  }
  function OwnPath: string;
  var
    FullPath: string;
  begin
    SetLength(FullPath, MAX_PATH);
    SetLength(FullPath, GetModuleFileName(hInstance, PChar(FullPath), Length(FullPath)));
    Result := IncludeTrailingPathDelimiter(ExtractFilePath(FullPath));
  end {OwnPath};
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  }
begin
  // TODO: Allow extensions to be enabled/disabled thru property of TCustomSQLiteDatabase
  Code := sqlite3_enable_load_extension(FDBHandle, 1);
  if Code <> SQLITE_OK then begin
    raise ESQLiteException.Create(Self, SQLiteErrorStr(Code));
  end;

  // Add our own path to the search path for LoadLibrary
  SetDllDirectory(PChar(OwnPath));
  try
    // If the provided path is relative, then prepend the current EXE or DLL's path
    if (Length(Extension) > 1) and not ((Extension[1] = PathDelim) or (Extension[2] = ':')) then begin
      Extension := OwnPath + Extension;
    end;

    ExtPath := StringToPUTF8Char(Extension);
    ExtEntryPoint := StringToPUTF8Char(EntryPoint);
    ExtErrMsg := ExtPath;
    Code := sqlite3_load_extension(FDBHandle, ExtPath, ExtEntryPoint, ExtErrMsg);
    if Code <> SQLITE_OK then begin
      ErrMsg := PUTF8CharToString(ExtErrMsg);
      SQlite3_Free(ExtErrMsg);
      inherited; // try it the SQL way
//      raise ESQLiteException.Create(Self, ErrMsg);
    end;
  finally
    // Restore the default DLL search path
    SetDllDirectory(nil);
  end;
end;

{ ================================================================================================ }
{ TSQLiteCursor }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteCursor.Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams);
begin
  FQuery := TSQLiteQuery.Create(DB, SQL, Params);
  FOwnsQuery := True;
  Create(FQuery);
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteCursor.Create(Query: TCustomSQLiteQuery);
begin
  inherited;

  // Get shortcuts to database and statement
  FDBHandle := (FDB as TSQLiteDatabase).Handle;
  FQueryHandle := TSQLiteQuery(Query).Handle;

  // Bind values to statement
  (FDB as TSQLiteDatabase).BindParams(FQueryHandle, Query.Parameters);

  // Figure out the columns
  DetermineColumns;

  // Fetch the first row
  Next;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TSQLiteCursor.Destroy;
begin
  if FOwnsQuery and Assigned(FQuery) then begin
    FreeAndNil(FQuery);
  end;
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteCursor.DetermineColumns;
var
  i, ColCount: Integer;
  ColDef: TSQLiteColumnDef;
  PColType: PAnsiChar;
  DeclaredColType: string;
begin
  // Assemble the column metadata
  ColCount := SQLite3_ColumnCount(FQueryHandle);
  for i := 0 to ColCount - 1 do begin
    ColDef := TSQLiteColumnDef.Create(Self);
    ColDef.Index := i;
    ColDef.Name := PUTF8CharToString(Sqlite3_ColumnName(FQueryHandle, i));

    PColType := Sqlite3_ColumnDeclType(FQueryHandle, i);
    if PColType = nil then begin
      ColDef.DataType := TSQLiteDataType(Sqlite3_ColumnType(FQueryHandle, i)); //use the actual column type instead
      //seems to be needed for last_insert_rowid
    end else begin
      // Guess data type as specified in http://www.sqlite.org/datatype3.html#affname
      DeclaredColType := UpperCase(PUTF8CharToString(PColType));
      if (Pos('INT', DeclaredColType) > 0)
          or (Pos('BOOL', DeclaredColType) > 0) then
      begin
        ColDef.DataType := dtInt;
      end else if (Pos('CHAR', DeclaredColType) > 0)
                or (Pos('CLOB', DeclaredColType) > 0)
                or (Pos('TEXT', DeclaredColType) > 0) then
      begin
        ColDef.DataType := dtStr;
      end else if (Pos('BLOB', DeclaredColType) > 0)
                or (DeclaredColType = '') then
      begin
        ColDef.DataType := dtBlob;
      end else {if (Pos('REAL', DeclaredColType) > 0)
                or (Pos('FLOA', DeclaredColType) > 0)
                or (Pos('DOUB', DeclaredColType) > 0) then}
      begin
        ColDef.DataType := dtNumeric;
      end;
    end;

    FColumnDefs.AddObject(ColDef.Name, ColDef);
    FFields.Add(TSQLiteField.Create(Self, i));
  end;
  OptimizeColumnDefs;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteCursor.Next: boolean;
var
  Code: Integer;
begin
  fEOF := True;
  Code := SQLite3_step(FQueryHandle);
  case Code of
    SQLITE_ROW: begin
      fEOF := false;
      Inc(FRowIndex);
    end;
    SQLITE_DONE: begin
      // we are on the end of dataset
      // return EOF=true only
    end;
    else begin
      SQLite3_reset(FQueryHandle);
      raise ESQLiteException.Create(FDB, FQuery.SQL, 'Unable to retrieve data: ' + SQLiteErrorStr(Code));
    end;
  end;
  Result := not fEOF;
  DoRowChanged;
end;


{ ================================================================================================ }
{ TSQLiteQuery }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteQuery.Create(DB: TCustomSQLiteDatabase; SQL: string; Params: TSQLiteParams = nil);
var
  Code: Integer;
  NextStatement: PAnsiChar;
  i: Integer;
begin
  Assert(DB is TSQLiteDatabase, 'TSQLiteQuery can only be used with TSQLiteDatabase or a descendant!');
  FQueryHandle := nil;
  inherited;

  Code := SQLite3_Prepare_v2(TSQLiteDatabase(FDB).FDBHandle,
                             StringToPUTF8Char(SQL), -1,
                             FQueryHandle, NextStatement); // TODO: what to do with the next statement?
  if Code <> SQLITE_OK then begin
    TSQLiteDatabase(FDB).RaiseError(SQL, Code);
  end;

  // if the Params collection was not supplied, populate it from SQLite
  if Params = nil then begin
    for i := 1 to sqlite3_bind_parameter_count(FQueryHandle) do begin
      Parameters.Add(PUTF8CharToString(sqlite3_bind_parameter_name(FQueryHandle, i)), nil);
    end;
  end;

  // Add this query to the database's list of queries, so it can be removed when the database
  //  is freed.
  TSQLiteDatabase(FDB).FQueries.Add(Self);
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TSQLiteQuery.Destroy;
var
  Code: Integer;
begin
  if Assigned(FQueryHandle) then begin
    Code := SQLite3_Finalize(FQueryHandle);
    Assert(Code = SQLITE_OK, SQLiteErrorStr(Code));

    // Remove this query from the database's list of queries
    TSQLiteDatabase(FDB).FQueries.Remove(Self);
  end;
  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteQuery.GetSQL: string;
var
  PSQL: PAnsiChar;
  USQL: UTF8String;
begin
  if Assigned(FQueryHandle) then begin
    PSQL := SQLite3_SQL(FQueryHandle);
{$IFDEF UNICODE}
    USQL := UTF8String(PSQL);
{$ELSE}
    USQL := Utf8ToAnsi(PSQL);
{$ENDIF}
    Result := Copy(string(USQL), 1);
  end else begin
    Result := '';
  end;
end;


{ ================================================================================================ }
{ TSQLiteField }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteField.Create(Parent: TCustomSQLiteCursor; ColumnIndex: integer);
begin
  inherited;
  FQueryHandle := (Parent as TSQLiteCursor).Handle;
  FColumnIndex := ColumnIndex;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.GetDataType: TSQLiteDataType;
begin
  Result := TSQLiteDataType(SQLite3_ColumnType(FQueryHandle, FColumnIndex));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.GetAsFloat: Double;
begin
  Result := SQLite3_ColumnDouble(FQueryHandle, FColumnIndex);
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.ReadAsFloat(IfNull: Double): Double;
begin
  case DataType of
    dtInt,
    dtNumeric:  Result := SQLite3_ColumnDouble(FQueryHandle, FColumnIndex);
    dtStr:      Result := StrToFloatDef(GetAsString, IfNull, Parent.Cursor.DB.FormatSettings);
    else        Result := IfNull;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.GetAsInteger: Int64;
begin
  Result := SQLite3_ColumnInt64(FQueryHandle, FColumnIndex);
end;
{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.ReadAsInteger(IfNull: Int64): Int64;
begin
  case DataType of
    dtInt,
    dtNumeric:  Result := SQLite3_ColumnInt64(FQueryHandle, FColumnIndex);
    dtStr:      Result := StrToInt64Def(GetAsString, IfNull);
    else        Result := IfNull;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.GetAsStream: TStream;
var
  BlobSize: Integer;
  Ptr: Pointer;
begin
  Result := TMemoryStream.Create;
  BlobSize := Sqlite3_ColumnBytes(FQueryHandle, FColumnIndex);
  if BlobSize > 0 then begin
    Ptr := Sqlite3_ColumnBlob(FQueryHandle, FColumnIndex);
    Result.WriteBuffer(Ptr^, BlobSize);
    Result.Position := 0;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.ReadAsString(IfNull: string): string;
begin
  Result := PUTF8CharToString(SQLite3_ColumnText(FQueryHandle, FColumnIndex));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteField.GetIsNull: Boolean;
begin
  Result := (GetDataType = dtNull);
end;

end.

Added src/lib/SQLite3Functions.pas.



































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
unit SQLite3Functions;

interface
uses
  Classes,
  SQLite3Abstract, sqlite3udf;

type

  TSQLiteFunctionInterface = class;

  TSQLiteUserFunction = procedure(SFI: TSQLiteFunctionInterface);

  TSQLiteFunctionInterface = class
  private
    FDB: TCustomSQLiteDatabase;
    FName: string;
    FParamCount: integer;
    FHandleStep: TSQLiteUserFunction;
    FHandleFinal: TSQLiteUserFunction;
    FData: TObject;

    FContext: Psqlite3_context;
    FArgCount: integer;
    FArgPtr: Psqlite3_value;

    function  GetIsAggregate: boolean;
    function  GetArg(Index: Integer): Pointer; inline;
  protected
    procedure DoScalar(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value);
    procedure DoStep(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value);
    procedure DoFinal(sqlite3_context: Psqlite3_context);
  public
    constructor Create(DB: TCustomSQLiteDatabase; Name: string; ParamCount: Integer; Data: TObject; Handler: TSQLiteUserFunction); overload;
    constructor Create(DB: TCustomSQLiteDatabase; Name: string; ParamCount: Integer; Data: TObject; Step, Final: TSQLiteUserFunction); overload;
    destructor  Destroy; override;

    function ArgType(Index: integer): TSQLiteDataType;
    function ArgNumType(Index: integer): TSQLiteDataType;
    function ArgIsNull(Index: integer): Boolean;
    function ArgAsInt(Index: integer): Integer;
    function ArgAsInt64(Index: integer): Int64;
    function ArgAsFloat(Index: integer): Double;
    function ArgAsString(Index: integer): string;
    function ArgAsUTF8String(Index: integer): UTF8String;
    function ArgAsWideString(Index: integer): WideString;

    procedure SetResult(Value: TMemoryStream; Copy: Boolean = False); overload;
    procedure SetResult(Value: TStream); overload;
    procedure SetResult(Value: Integer); overload;
    procedure SetResult(Value: Int64); overload;
    procedure SetResult(Value: Double); overload;
    procedure SetResult(Value: string); overload;
    procedure SetResult(Value: WideString); overload;
    procedure SetResult(Value: UTF8String); overload;

    property DB: TCustomSQLiteDatabase    read FDB;
    property FunctionName: string         read FName;
    property ParamCount: integer          read FParamCount;
    property Data: TObject                read FData;
    property IsAggregateFunction: boolean read GetIsAggregate;

    property ArgCount: integer            read FArgCount;
  end;


implementation

uses
  SysUtils,
  SQLite3, SQLite3Database;

{ ------------------------------------------------------------------------------------------------ }
procedure ScalarFunctionHandler(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value); cdecl;
begin
  TSQLiteFunctionInterface(sqlite3_user_data(sqlite3_context)).DoScalar(sqlite3_context, cArg, ArgV);
end;
{ ------------------------------------------------------------------------------------------------ }
procedure AggregateStepHandler(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value); cdecl;
begin
  TSQLiteFunctionInterface(sqlite3_user_data(sqlite3_context)).DoStep(sqlite3_context, cArg, ArgV);
end;
{ ------------------------------------------------------------------------------------------------ }
procedure AggregateFinalHandler(sqlite3_context: Psqlite3_context); cdecl;
begin
  TSQLiteFunctionInterface(sqlite3_user_data(sqlite3_context)).DoFinal(sqlite3_context);
end;




{ ================================================================================================ }
{ TSQLiteFunctionInterface }

{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteFunctionInterface.Create(DB: TCustomSQLiteDatabase; Name: string;
  ParamCount: Integer; Data: TObject; Handler: TSQLiteUserFunction);
var
  Code: Integer;
begin
  FDB := DB;
  FName := Name;
  FParamCount := ParamCount;
  FData := Data;
  FHandleStep := nil;
  FHandleFinal := Handler;

  Code := sqlite3_create_function(TSQLiteDatabase(DB).Handle,
                                  StringToPUTF8Char(Name), ParamCount, SQLITE_UTF8, Self,
                                  ScalarFunctionHandler, nil, nil);
  if Code <> SQLITE_OK then begin
    raise ESQLiteException.Create(DB, 'Unable to create SQL function "' + Name + '".');
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TSQLiteFunctionInterface.Create(DB: TCustomSQLiteDatabase; Name: string;
  ParamCount: Integer; Data: TObject; Step, Final: TSQLiteUserFunction);
var
  Code: Integer;
begin
  FDB := DB;
  FName := Name;
  FParamCount := ParamCount;
  FData := Data;
  FHandleStep := Step;
  FHandleFinal := Final;

  Code := sqlite3_create_function(TSQLiteDatabase(DB).Handle,
                                  StringToPUTF8Char(Name), ParamCount, SQLITE_UTF8, Self,
                                  nil, AggregateStepHandler, AggregateFinalHandler);
  if Code <> SQLITE_OK then begin
    raise ESQLiteException.Create(DB, 'Unable to create SQL function "' + Name + '".');
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TSQLiteFunctionInterface.Destroy;
var
  Code: Integer;
begin
  Code := sqlite3_create_function(TSQLiteDatabase(DB).Handle,
                                  StringToPUTF8Char(FName), FParamCount, SQLITE_UTF8, nil,
                                  nil, nil, nil);
  if Code <> SQLITE_OK then begin
    raise ESQLiteException.Create(DB, 'Unable to remove SQL function "' + FName + '".');
  end;

  inherited;
end;


{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.DoScalar(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value);
begin
  try
    FContext := sqlite3_context;
    FArgCount := cArg;
    FArgPtr := ArgV;
    try
      FHandleFinal(Self);
    except
      on E: Exception do begin
        sqlite3_result_error(sqlite3_context, StringToPUTF8Char(FName + ': ' + E.Message), -1);
      end;
    end;
  finally
    FContext := nil;
    FArgCount := -1;
    FArgPtr := nil;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.DoStep(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value);
begin
  try
    FContext := sqlite3_context;
    FArgCount := cArg;
    FArgPtr := ArgV;
    try
      FHandleStep(Self);
    except
      on E: Exception do begin
        sqlite3_result_error(sqlite3_context, StringToPUTF8Char(FName + ': ' + E.Message), -1);
      end;
    end;
  finally
    FContext := nil;
    FArgCount := -1;
    FArgPtr := nil;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.DoFinal(sqlite3_context: Psqlite3_context);
begin
  try
    FContext := sqlite3_context;
    FArgCount := -1;
    FArgPtr := nil;
    try
      FHandleFinal(Self);
    except
      on E: Exception do begin
        sqlite3_result_error(sqlite3_context, StringToPUTF8Char(FName + ': ' + E.Message), -1);
      end;
    end;
  finally
    FContext := nil;
  end;
end;


{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.GetIsAggregate: boolean;
begin
  Result := Assigned(FHandleStep);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: string);
begin
  sqlite3_result_text(FContext, StringToPUTF8Char(Value), -1, SQLITE_TRANSIENT);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: WideString);
begin
  sqlite3_result_text16(FContext, PWideChar(Value), ByteLength(Value), SQLITE_TRANSIENT);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: UTF8String);
begin
  sqlite3_result_text(FContext, PAnsiChar(Value), -1, SQLITE_TRANSIENT);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: Integer);
begin
  sqlite3_result_int(FContext, Value);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: TMemoryStream; Copy: Boolean = False);
var
  Destroy: Pointer;
begin
  if Assigned(Value) then begin
    if Copy then
      Destroy := SQLITE_TRANSIENT
    else
      Destroy := SQLITE_STATIC;
    sqlite3_result_blob(FContext, Value.Memory, Value.Size, Destroy);
  end else begin
    sqlite3_result_null(FContext);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: TStream);
var
  MS: TMemoryStream;
begin
  if Assigned(Value) then begin
    MS := TMemoryStream.Create;
    try
      Value.Position := 0;
      MS.CopyFrom(Value, Value.Size);
      sqlite3_result_blob(FContext, MS.Memory, MS.Size, SQLITE_TRANSIENT);
    finally
      MS.Free;
    end;
  end else begin
    sqlite3_result_null(FContext);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: Double);
begin
  sqlite3_result_double(FContext, Value);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TSQLiteFunctionInterface.SetResult(Value: Int64);
begin
  sqlite3_result_int64(FContext, Value);
end;


{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.GetArg(Index: Integer): Pointer;
var
  VArg: Psqlite3_value;
  i: Integer;
begin
  if (Index < 0) or (Index >= FArgCount) then
    raise EListError.CreateFmt('List index out of bounds (%d).', [Index]);
  VArg := FArgPtr;
  for i := 1 to FArgCount - 1 do begin
    Inc(VArg);
  end;
  Result := VArg^;
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgAsFloat(Index: integer): Double;
begin
  Result := sqlite3_value_double(GetArg(Index));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgAsInt(Index: integer): Integer;
begin
  Result := sqlite3_value_int(GetArg(Index));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgAsInt64(Index: integer): Int64;
begin
  Result := sqlite3_value_int64(GetArg(Index));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgAsString(Index: integer): string;
begin
{$IFDEF UNICODE}
  Result := string(sqlite3_value_text16(GetArg(Index)));
{$ELSE}
  Result := Utf8ToAnsi(sqlite3_value_text(GetArg(Index)));
{$ENDIF}
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgAsUTF8String(Index: integer): UTF8String;
begin
{$IFDEF UNICODE}
  Result := sqlite3_value_text(GetArg(Index));
{$ELSE}
  Result := Utf8ToAnsi(sqlite3_value_text(GetArg(Index)));
{$ENDIF}
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgAsWideString(Index: integer): WideString;
begin
  Result := WideString(sqlite3_value_text16(GetArg(Index)));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgIsNull(Index: integer): Boolean;
begin
  Result := (sqlite3_value_type(GetArg(Index)) = SQLITE_NULL);
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgNumType(Index: integer): TSQLiteDataType;
begin
  Result := TSQLiteDataType(sqlite3_value_numeric_type(GetArg(Index)));
end;

{ ------------------------------------------------------------------------------------------------ }
function TSQLiteFunctionInterface.ArgType(Index: integer): TSQLiteDataType;
begin
  Result := TSQLiteDataType(sqlite3_value_type(GetArg(Index)));
end;

end.

Added src/lib/SQLite3Remote.pas.































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
unit SQLite3Remote;

interface
uses
  SQLite3Abstract, SysUtils;

type
  TRemoteSQLiteDatabase = class(TCustomSQLiteDatabase)
  protected
    function  GetIsInTransaction: Boolean;      override; // TODO: keep track of transactions; only send data only on commit
    function  GetTimeout: Integer;              override; // TODO: transmit timeout, and also use it for connection timeout
    procedure SetTimeout(const Value: Integer); override;
    function  GetLocation: string;              override; // TODO: http://host:port/path/ to SQLiteServer
  public
    constructor Create(Location: string); override; // TODO: test connection to given URL
    destructor  Destroy; override;                  // TODO: Clean up connection

    function PrepareSQL(SQL: string): TCustomSQLiteQuery; override; // TODO: Create TRemoteSQLiteQuery
    function Execute(SQL: string; Params: TSQLiteParams): string; overload; override; // TODO: if in transaction, remember this; otherwise execute
    function Execute(Query: TCustomSQLiteQuery): Int64; overload; override; // TODO: if in transaction, remember this; otherwise execute
    function ExecuteAll(SQL: string; Params: TSQLiteParams): Int64; overload; override; // TODO: if in transaction, remember this; otherwise execute
    function GetCursor(Query: TCustomSQLiteQuery): TCustomSQLiteCursor; overload; override; // TODO: Create TRemoteSQLiteCursor

    procedure BeginTransaction; override; // TODO: start transaction
    procedure Commit; override; // TODO: send all statements collected since start of transaction
    procedure Rollback; override; // TODO: free all statements collected since start of transaction
    procedure SavePoint(SavepointName: string); overload; override; // TODO: keep track of savepoints, and check transaction level
    procedure Release(SavepointName: string); overload; override; // TODO: get rid of given savepoint, and all the following ones
    procedure RollbackTo(SavepointName: string); overload; override; // TODO: rollback to given savepoint

    procedure AttachDatabase(Location, Prefix: string); override; // TODO: raise error?  Or Just check and strip paths?
    procedure LoadExtension(Extension: string; EntryPoint: string = ''); override; // TODO: raise error?  Or just check and strip paths?

    property FormatSettings;
    property Timeout;
    property Location;
    property Parameters;
    property Version;
    property LastInsertRowID;
    property RecentChanges;
    property TotalChanges;
    property IsInTransaction;
  end;

implementation

end.

Added src/lib/sqlite3udf.pas.























































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
{
UDF Sqlite3 support v1.0.0
  translation to Pascal by Lukas Gebauer

This is experimental translation. Be patient!
}
unit sqlite3udf;

interface

uses
  sqlite3;

type
  Psqlite3_context = Pointer;
  Psqlite3_value = PPAnsiChar;

  TxFunc = procedure(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value); cdecl;
  TxStep = procedure(sqlite3_context: Psqlite3_context; cArg: integer; ArgV: Psqlite3_value); cdecl;
  TxFinal = procedure(sqlite3_context: Psqlite3_context); cdecl;
{
  void (*xFunc)(sqlite3_context*,int,sqlite3_value**),
  void (*xStep)(sqlite3_context*,int,sqlite3_value**),
  void (*xFinal)(sqlite3_context*)
}

//UDF SQLITE3 support
function sqlite3_create_function(db: TSQLiteDB; functionName: PAnsiChar; nArg: integer;
  eTextRep: integer; pUserdata: pointer; xFunc: TxFunc; xStep: TxStep; xFinal: TxFinal
  ): integer; cdecl; external SQLiteDLL name 'sqlite3_create_function';

function sqlite3_user_data(sqlite3_context: Psqlite3_context): Pointer;
  cdecl; external SQLiteDLL name 'sqlite3_user_data';
{
   void *sqlite3_user_data(sqlite3_context*);
}

procedure sqlite3_result_blob(sqlite3_context: Psqlite3_context; value: Pointer;
  n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_blob';
procedure sqlite3_result_double(sqlite3_context: Psqlite3_context; value: Double);
  cdecl; external SQLiteDLL name 'sqlite3_result_double';
procedure sqlite3_result_error(sqlite3_context: Psqlite3_context; value: PAnsiChar;
  n: integer); cdecl; external SQLiteDLL name 'sqlite3_result_error';
procedure sqlite3_result_error16(sqlite3_context: Psqlite3_context; value: PWidechar;
  n: integer); cdecl; external SQLiteDLL name 'sqlite3_result_error16';
procedure sqlite3_result_int(sqlite3_context: Psqlite3_context; value: integer);
  cdecl; external SQLiteDLL name 'sqlite3_result_int';
procedure sqlite3_result_int64(sqlite3_context: Psqlite3_context; value: int64);
  cdecl; external SQLiteDLL name 'sqlite3_result_int64';
procedure sqlite3_result_null(sqlite3_context: Psqlite3_context);
  cdecl; external SQLiteDLL name 'sqlite3_result_null';
procedure sqlite3_result_text(sqlite3_context: Psqlite3_context; value: PAnsiChar;
  n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text';
procedure sqlite3_result_text16(sqlite3_context: Psqlite3_context; value: PWideChar;
  n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text16';
procedure sqlite3_result_text16be(sqlite3_context: Psqlite3_context; value: PWideChar;
  n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text16be';
procedure sqlite3_result_text16le(sqlite3_context: Psqlite3_context; value: PWideChar;
  n: integer; destroy: pointer); cdecl; external SQLiteDLL name 'sqlite3_result_text16le';
procedure sqlite3_result_value(sqlite3_context: Psqlite3_context; value: Psqlite3_value);
  cdecl; external SQLiteDLL name 'sqlite3_result_value';

{
    void sqlite3_result_blob(sqlite3_context*, const void*, int n, void(*)(void*));
    void sqlite3_result_double(sqlite3_context*, double);
    void sqlite3_result_error(sqlite3_context*, const char*, int);
    void sqlite3_result_error16(sqlite3_context*, const void*, int);
    void sqlite3_result_int(sqlite3_context*, int);
    void sqlite3_result_int64(sqlite3_context*, long long int);
    void sqlite3_result_null(sqlite3_context*);
    void sqlite3_result_text(sqlite3_context*, const char*, int n, void(*)(void*));
    void sqlite3_result_text16(sqlite3_context*, const void*, int n, void(*)(void*));
    void sqlite3_result_text16be(sqlite3_context*, const void*, int n, void(*)(void*));
    void sqlite3_result_text16le(sqlite3_context*, const void*, int n, void(*)(void*));
    void sqlite3_result_value(sqlite3_context*, sqlite3_value*);
}

function sqlite3_value_blob(value: pointer): Pointer;
  cdecl; external SQLiteDLL name 'sqlite3_value_blob';
function sqlite3_value_bytes(value: pointer): integer;
  cdecl; external SQLiteDLL name 'sqlite3_value_bytes';
function sqlite3_value_bytes16(value: pointer): integer;
  cdecl; external SQLiteDLL name 'sqlite3_value_bytes16';
function sqlite3_value_double(value: pointer): double;
  cdecl; external SQLiteDLL name 'sqlite3_value_double';
function sqlite3_value_int(value: pointer): integer;
  cdecl; external SQLiteDLL name 'sqlite3_value_int';
function sqlite3_value_int64(value: pointer): int64;
  cdecl; external SQLiteDLL name 'sqlite3_value_int64';
function sqlite3_value_text(value: pointer): PAnsiChar;
  cdecl; external SQLiteDLL name 'sqlite3_value_text';
function sqlite3_value_text16(value: pointer): PWideChar;
  cdecl; external SQLiteDLL name 'sqlite3_value_text16';
function sqlite3_value_text16be(value: pointer): PWideChar;
  cdecl; external SQLiteDLL name 'sqlite3_value_text16be';
function sqlite3_value_text16le(value: pointer): PWideChar;
  cdecl; external SQLiteDLL name 'sqlite3_value_text16le';
function sqlite3_value_type(value: pointer): integer;
  cdecl; external SQLiteDLL name 'sqlite3_value_type';
function sqlite3_value_numeric_type(value: pointer): integer;
  cdecl; external SQLiteDLL name 'sqlite3_value_numeric_type';

{    const void *sqlite3_value_blob(sqlite3_value*);
    int sqlite3_value_bytes(sqlite3_value*);
    int sqlite3_value_bytes16(sqlite3_value*);
    double sqlite3_value_double(sqlite3_value*);
    int sqlite3_value_int(sqlite3_value*);
    long long int sqlite3_value_int64(sqlite3_value*);
    const unsigned char *sqlite3_value_text(sqlite3_value*);
    const void *sqlite3_value_text16(sqlite3_value*);
    const void *sqlite3_value_text16be(sqlite3_value*);
    const void *sqlite3_value_text16le(sqlite3_value*);
    int sqlite3_value_type(sqlite3_value*);
}

{
//Sample of usage:
PROCEDURE fn(ctx:pointer;n:integer;args:ppchar);cdecl;
VAR     p : ppchar; theString : string; res:integer;
BEGIN
p         := args;
theString := trim(sqlite3_value_text(p^));

...do something with theString...

sqlite3_result_int(ctx,res);  // < return a number based on string
END;
...
var i:integer;
begin
i := sqlite3_create_function(db3,'myfn',1,SQLITE_UTF8,nil,@fn,nil,nil);
s := 'select myfn(thestring) from theTable;'
...execute statement...
end;
}

implementation

end.

Added src/prj/D2010/Olam.dpr.





























>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
program Olam;

uses
  Forms,
  F_Entry in '..\..\F_Entry.pas' {frmEntry};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmEntry, frmEntry);
  Application.Run;
end.

Added src/prj/D2010/Olam.dproj.





































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
	<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
		<PropertyGroup>
			<ProjectGuid>{C388C4E5-7E2F-4B05-8141-39DF450276E2}</ProjectGuid>
			<ProjectVersion>12.0</ProjectVersion>
			<MainSource>Olam.dpr</MainSource>
			<Config Condition="'$(Config)'==''">Debug</Config>
			<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
		</PropertyGroup>
		<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
			<Base>true</Base>
		</PropertyGroup>
		<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
			<Cfg_1>true</Cfg_1>
			<CfgParent>Base</CfgParent>
			<Base>true</Base>
		</PropertyGroup>
		<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
			<Cfg_2>true</Cfg_2>
			<CfgParent>Base</CfgParent>
			<Base>true</Base>
		</PropertyGroup>
		<PropertyGroup Condition="'$(Base)'!=''">
			<DCC_UnitSearchPath>..\..\lib;..\..;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
			<DCC_DependencyCheckOutputName>..\..\..\out\Olam.exe</DCC_DependencyCheckOutputName>
			<DCC_ImageBase>00400000</DCC_ImageBase>
			<DCC_UsePackage>vclx;vcl;vclimg;dbrtl;Rave77VCL;bdertl;rtl;vclactnband;vcldb;vcldbx;vcltouch;xmlrtl;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;inetdb;webdsnap;websnap;inetdbbde;inetdbxpress;soaprtl;vclribbon;DbxCommonDriver;DbxClientDriver;DBXInterBaseDriver;DBXMySQLDriver;dbexpress;dbxcds;DCPdelphi2010</DCC_UsePackage>
			<DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)</DCC_UnitAlias>
			<DCC_Platform>x86</DCC_Platform>
			<DCC_ExeOutput>..\..\..\out\</DCC_ExeOutput>
			<DCC_DcuOutput>..\..\..\out\DCU\</DCC_DcuOutput>
		</PropertyGroup>
		<PropertyGroup Condition="'$(Cfg_1)'!=''">
			<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
			<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
			<DCC_DebugInformation>false</DCC_DebugInformation>
			<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
			<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
		</PropertyGroup>
		<PropertyGroup Condition="'$(Cfg_2)'!=''">
			<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
			<DCC_RangeChecking>true</DCC_RangeChecking>
			<DCC_Optimize>false</DCC_Optimize>
			<DCC_IntegerOverflowCheck>true</DCC_IntegerOverflowCheck>
			<DCC_RunTimeTypeInfo>true</DCC_RunTimeTypeInfo>
		</PropertyGroup>
		<ItemGroup>
			<DelphiCompile Include="Olam.dpr">
				<MainSource>MainSource</MainSource>
			</DelphiCompile>
			<DCCReference Include="..\..\F_Entry.pas">
				<Form>frmEntry</Form>
			</DCCReference>
			<BuildConfiguration Include="Base">
				<Key>Base</Key>
			</BuildConfiguration>
			<BuildConfiguration Include="Debug">
				<Key>Cfg_2</Key>
				<CfgParent>Base</CfgParent>
			</BuildConfiguration>
			<BuildConfiguration Include="Release">
				<Key>Cfg_1</Key>
				<CfgParent>Base</CfgParent>
			</BuildConfiguration>
		</ItemGroup>
		<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
		<ProjectExtensions>
			<Borland.Personality>Delphi.Personality.12</Borland.Personality>
			<Borland.ProjectType/>
			<BorlandProject>
				<Delphi.Personality>
					<Source>
						<Source Name="MainSource">Olam.dpr</Source>
					</Source>
					<Parameters>
						<Parameters Name="UseLauncher">False</Parameters>
						<Parameters Name="LoadAllSymbols">True</Parameters>
						<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
					</Parameters>
					<VersionInfo>
						<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
						<VersionInfo Name="AutoIncBuild">False</VersionInfo>
						<VersionInfo Name="MajorVer">1</VersionInfo>
						<VersionInfo Name="MinorVer">0</VersionInfo>
						<VersionInfo Name="Release">0</VersionInfo>
						<VersionInfo Name="Build">0</VersionInfo>
						<VersionInfo Name="Debug">False</VersionInfo>
						<VersionInfo Name="PreRelease">False</VersionInfo>
						<VersionInfo Name="Special">False</VersionInfo>
						<VersionInfo Name="Private">False</VersionInfo>
						<VersionInfo Name="DLL">False</VersionInfo>
						<VersionInfo Name="Locale">1043</VersionInfo>
						<VersionInfo Name="CodePage">1252</VersionInfo>
					</VersionInfo>
					<VersionInfoKeys>
						<VersionInfoKeys Name="CompanyName"/>
						<VersionInfoKeys Name="FileDescription"/>
						<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
						<VersionInfoKeys Name="InternalName"/>
						<VersionInfoKeys Name="LegalCopyright"/>
						<VersionInfoKeys Name="LegalTrademarks"/>
						<VersionInfoKeys Name="OriginalFilename"/>
						<VersionInfoKeys Name="ProductName"/>
						<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
						<VersionInfoKeys Name="Comments"/>
					</VersionInfoKeys>
					<Excluded_Packages>
						<Excluded_Packages Name="$(BDS)\bin\dcloffice2k140.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
						<Excluded_Packages Name="$(BDS)\bin\dclofficexp140.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
					</Excluded_Packages>
				</Delphi.Personality>
			</BorlandProject>
			<ProjectFileVersion>12</ProjectFileVersion>
		</ProjectExtensions>
	</Project>

Added src/prj/D2010/Olam.res.

cannot compute difference between binary files