Unit SQLiteTable3U;

{
  Simple classes for using SQLite's exec and get_table.

  TSQLiteDatabase wraps the calls to open and close an SQLite database.
  It also wraps SQLite_exec for queries that do not return a result set

  TSQLiteTable wraps sqlite_get_table.
  It allows accessing fields by name as well as index and can step through a
  result set with the Next procedure.

  Adapted by Tim Anderson (tim@itwriting.com)
  Originally created by Pablo Pissanetzky (pablo@myhtpc.net)
  Modified and enhanced by Lukas Gebauer
}
{$I Sqlite.inc}
Interface

Uses
  Windows, SQLite3Lib, Sqlite3Types, TntClasses, Classes, SysUtils;

Type
  ESQLiteException = Class(Exception)
  End;

  TSQLiteTable = Class;

  TSQLiteDatabase = Class
  Private
    fPassWord, fOldPassWord: WideString;
    fDB: TSQLiteDB;
    fInTrans: boolean;
    Procedure RaiseError(s: WideString; SQL: WideString);
  Public
    Constructor Create(Const FileName: WideString; Const PassWord: WideString = '');
    Destructor Destroy; Override;
    Function GetTable(Const SQL: WideString): TSQLiteTable;
    Procedure ExecSQL(Const SQL: WideString);
    Function GetTableValue(Const SQL: WideString): int64;
    Function GetTableString(Const SQL: WideString): WideString;
    Procedure UpdateBlob(Const SQL: WideString; BlobData: TStream);
    Procedure BeginTransaction;
    Procedure Commit;
    Procedure Rollback;
    Function TableExists(TableName: WideString): boolean;
    Function GetLastInsertRowID: int64;
    Procedure SetTimeout(Value: integer);
    Function version: WideString;
    Property DB: TSQLiteDB Read fDB;
  Published
    Property isTransactionOpen: boolean Read fInTrans;
    Property PassWord: WideString Read fPassWord Write fPassWord;
  End;

  TSQLiteTable = Class
  Private
    fResults: TList;
    fRowCount: cardinal;
    fColCount: cardinal;
    fCols: TTntStrings;
    fColTypes: TList;
    fRow: cardinal;
    Function GetFields(I: cardinal): WideString;
    Function GetEOF: boolean;
    Function GetBOF: boolean;
    Function GetColumns(I: integer): WideString;
    Function GetFieldByName(FieldName: WideString): WideString;
    Function GetFieldIndex(FieldName: WideString): integer;
    Function GetCount: integer;
    Function GetCountResult: integer;
  Public
    Constructor Create(DB: TSQLiteDatabase; Const SQL: WideString);
    Destructor Destroy; Override;
    Function FieldAsInteger(I: cardinal): int64;
    Function FieldAsBlob(I: cardinal): TMemoryStream;
    Function FieldAsBlobText(I: cardinal): WideString;
    Function FieldIsNull(I: cardinal): boolean;
    Function FieldAsString(I: cardinal): WideString;
    Function FieldAsDouble(I: cardinal): double;
    Function Next: boolean;
    Function Previous: boolean;
    Property Eof: boolean Read GetEOF;
    Property BOF: boolean Read GetBOF;
    Property Fields[I: cardinal]: WideString Read GetFields;
    Property FieldByName[FieldName: WideString]: WideString Read GetFieldByName;
    Property FieldIndex[FieldName: WideString]: integer Read GetFieldIndex;
    Property Columns[I: integer]: WideString Read GetColumns;
    Property ColCount: cardinal Read fColCount;
    Property RowCount: cardinal Read fRowCount;
    Property Row: cardinal Read fRow;
    Function MoveFirst: boolean;
    Function MoveLast: boolean;
    Property Count: integer Read GetCount;
    // The property CountResult is used when you execute count(*) queries.
    // It returns 0 if the result set is empty or the value of the
    // first field as an integer.
    Property CountResult: integer Read GetCountResult;
  End;

Procedure DisposePointer(ptr: pointer); cdecl;
Function UTF8(Const ASQL: WideString): PAnsiChar;
Function UnUTF8(Const AUTF: String): WideString;

Implementation

Procedure DisposePointer(ptr: pointer); Cdecl;
Begin
  If Assigned(ptr) Then
    FreeMem(ptr);
End;

Function UTF8(Const ASQL: WideString): PAnsiChar;
Begin
  Result := PAnsiChar(UTF8Encode(ASQL));
End;

Function UnUTF8(Const AUTF: String): WideString;
Begin
  Result := UTF8DeCode(AUTF);
End;

//------------------------------------------------------------------------------
// TSQLiteDatabase
//------------------------------------------------------------------------------

Constructor TSQLiteDatabase.Create(Const FileName: WideString; Const PassWord: WideString = '');
Var
  Msg: PAnsiChar;
  iResult: integer;
Begin
  Inherited Create;
  SQLite3LoadLibrary;
  self.fInTrans := False;

  Msg := Nil;
  Try
    iResult := SQLite3_Open(UTF8(FileName), fDB);

    If iResult <> SQLITE_OK Then
      If Assigned(fDB) Then
      Begin
        Msg := Sqlite3_ErrMsg(fDB);
        Raise ESQLiteException.CreateFmt('Failed to open database "%s" : %s',
          [FileName, Msg]);
      End
      Else
        Raise ESQLiteException.CreateFmt('Failed to open database "%s" : unknown error',
          [FileName]);
    If PassWord <> '' Then
    Begin
      fPassWord := PassWord;
      fOldPassWord := fPassWord;
      {$IFDEF UseSQLiteCrypt}
      If Assigned(SqLite3_Key) Then
        SqLite3_Key(fDB, UTF8(fPassWord), Length(fPassWord) * 2);
      {$ENDIF}
    End;
    //set a few configs
    self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;');
    //    self.ExecSQL('PRAGMA full_column_names = 1;');
    self.ExecSQL('PRAGMA temp_store = MEMORY;');

  Finally
    If Assigned(Msg) Then
      SQLite3_Free(Msg);
  End;

End;

//..............................................................................

Destructor TSQLiteDatabase.Destroy;
Begin

  If self.fInTrans Then
    self.ExecSQL('ROLLBACK;');          //assume rollback

  If WideCompareStr(FPassWord, FOldPassWord) <> 0 Then
  Begin
    {$IFDEF UseSQLiteCrypt}
    If Assigned(SqLite3_Rekey) Then
      SqLite3_Rekey(fDB, UTF8(fPassWord), Length(fPassWord) * 2);
    {$ENDIF}
  End;

  If Assigned(fDB) Then
    SQLite3_Close(fDB);
  SQLite3FreeLibrary;
  Inherited;
End;

Function TSQLiteDatabase.GetLastInsertRowID: int64;
Begin
  Result := SQLite3_Last_Insert_RowID(self.fDB);
End;

//..............................................................................

Procedure TSQLiteDatabase.RaiseError(s: WideString; SQL: WideString);
//look up last error and raise an exception with an appropriate message
Var
  Msg: PAnsiChar;
Begin

  Msg := Nil;

  If SQLite3_ErrCode(self.fDB) <> SQLITE_OK Then
    Msg := Sqlite3_ErrMsg(self.fDB);

  If Msg <> Nil Then
    Raise ESQLiteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg])
  Else
    Raise ESQLiteException.CreateFmt(s, [SQL, 'No message']);

End;

Procedure TSQLiteDatabase.ExecSQL(Const SQL: WideString);
Var
  Stmt: TSQLiteStmt;
  NextSQLStatement: PAnsiChar;
  iStepResult: integer;
Begin
  Try

    If Sqlite3_Prepare(self.fDB, UTF8(SQL), -1, Stmt, NextSQLStatement) <>
      SQLITE_OK Then
      RaiseError('Error executing SQL', SQL);

    If (Stmt = Nil) Then
      RaiseError('Could not prepare SQL statement', SQL);

    iStepResult := Sqlite3_step(Stmt);

    If (iStepResult <> SQLITE_DONE) Then
      RaiseError('Error executing SQL statement', SQL);

  Finally

    If Assigned(Stmt) Then
      Sqlite3_Finalize(Stmt);

  End;
End;

Procedure TSQLiteDatabase.UpdateBlob(Const SQL: WideString; BlobData: TStream);
Var
  iSize: integer;
  ptr: pointer;
  Stmt: TSQLiteStmt;
  Msg: PAnsiChar;
  NextSQLStatement: PAnsiChar;
  iStepResult: integer;
  iBindResult: integer;
Begin
  //expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1'

  If Pos('?', SQL) = 0 Then
    RaiseError('SQL must include a ? parameter', SQL);

  Msg := Nil;
  Try

    If Sqlite3_Prepare(self.fDB, UTF8(SQL), -1, Stmt, NextSQLStatement) <>
      SQLITE_OK Then
      RaiseError('Could not prepare SQL statement', SQL);

    If (Stmt = Nil) Then
      RaiseError('Could not prepare SQL statement', SQL);

    //now bind the blob data
    iSize := BlobData.size;

    GetMem(ptr, iSize);

    If (ptr = Nil) Then
      Raise ESQLiteException.CreateFmt('Error getting memory to save blob',
        [SQL, 'Error']);

    BlobData.position := 0;
    BlobData.Read(ptr^, iSize);

    iBindResult := SQLite3_Bind_Blob(Stmt, 1, ptr, iSize, @DisposePointer);

    If iBindResult <> SQLITE_OK Then
      RaiseError('Error binding blob to database', SQL);

    iStepResult := Sqlite3_step(Stmt);

    If (iStepResult <> SQLITE_DONE) Then
      RaiseError('Error executing SQL statement', SQL);

  Finally

    If Assigned(Stmt) Then
      Sqlite3_Finalize(Stmt);

    If Assigned(Msg) Then
      SQLite3_Free(Msg);
  End;

End;

//..............................................................................

Function TSQLiteDatabase.GetTable(Const SQL: WideString): TSQLiteTable;
Begin
  Result := TSQLiteTable.Create(self, SQL);
End;

Function TSQLiteDatabase.GetTableValue(Const SQL: WideString): int64;
Var
  Table: TSQLiteTable;
Begin
  Result := 0;
  Table := self.GetTable(SQL);
  Try
    If Table.RowCount > 0 Then
      Result := Table.FieldAsInteger(0);
  Finally
    Table.Free;
  End;
End;

Function TSQLiteDatabase.GetTableString(Const SQL: WideString): WideString;
Var
  Table: TSQLiteTable;
Begin
  Result := '';
  Table := self.GetTable(SQL);
  Try
    If Table.RowCount > 0 Then
      Result := Table.FieldAsString(0);
  Finally
    Table.Free;
  End;
End;

Procedure TSQLiteDatabase.BeginTransaction;
Begin
  If Not self.fInTrans Then
  Begin
    self.ExecSQL('BEGIN TRANSACTION;');
    self.fInTrans := True;
  End
  Else
    Raise ESQLiteException.Create('Transaction already open');
End;

Procedure TSQLiteDatabase.Commit;
Begin
  self.ExecSQL('COMMIT;');
  self.fInTrans := False;
End;

Procedure TSQLiteDatabase.Rollback;
Begin
  self.ExecSQL('ROLLBACK;');
  self.fInTrans := False;
End;

Function TSQLiteDatabase.TableExists(TableName: WideString): boolean;
Var
  SQL: WideString;
  ds: TSQLiteTable;
Begin
  //returns true if table exists in the database
  SQL := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' +
    LowerCase(TableName) + ''' ';
  ds := self.GetTable(SQL);
  Try
    Result := (ds.Count > 0);
  Finally
    ds.Free;
  End;
End;

Procedure TSQLiteDatabase.SetTimeout(Value: integer);
Begin
  SQLite3_Busy_Timeout(self.fDB, Value);
End;

Function TSQLiteDatabase.version: WideString;
Begin
  Result := SQLite3_LibVersion;
End;

//------------------------------------------------------------------------------
// TSQLiteTable
//------------------------------------------------------------------------------

Constructor TSQLiteTable.Create(DB: TSQLiteDatabase; Const SQL: WideString);
Var