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.

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.

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.

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.

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.

{
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.

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.

	<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>