source: oup/releases/0.17a/SQLiteTable3.pas@ 34

unit SQLiteTable3;

{
  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)
}

interface

uses
  Windows, SQLite3, Classes, Sysutils;

const
  dtStr = 0;
  dtInt = 1;
  dtBool = 2;
  dtNumeric = 3;
  dtBlob = 4;

type

  ESQLiteException = class(Exception)
  private
  public
  end;

  TSQLiteTable = class;

  TSQLiteDatabase = class
  private
    fDB: TSQLiteDB;
    fInTrans: Boolean;
    procedure RaiseError(s: string; SQL: string);

  public
    constructor Create(const FileName: string);
    destructor Destroy; override;
    function GetTable(const SQL: string): TSQLiteTable;
    procedure ExecSQL(const SQL: string);
    procedure UpdateBlob(const SQL: string; BlobData: TStream);
    procedure BeginTransaction;
    procedure Commit;
    procedure Rollback;
    function TableExists(TableName: string): boolean;
    function GetLastInsertRowID: int64;

  published
    property isTransactionOpen: boolean read fInTrans;

  end;

  TSQLiteTable = class
  private
    fResults: TList;
    fRowCount: Cardinal;
    fColCount: Cardinal;
    fCols: TStringList;
    fColTypes: TList;
    fRow: Cardinal;

    function GetFields(I: Integer): string;
    function GetEOF: Boolean;
    function GetBOF: Boolean;
    function GetColumns(I: Integer): string;
    function GetFieldByName(FieldName: string): string;
    function GetFieldIndex(FieldName: string): integer;
    function GetCount: Integer;
    function GetCountResult: Integer;


  public
    constructor Create(DB: TSQLiteDatabase; const SQL: string);
    destructor Destroy; override;
    function FieldAsInteger(FieldName: string): integer;
    function FieldAsBool(FieldName: string): boolean;
    function FieldAsBlob(FieldName: string): TMemoryStream;
    function FieldAsBlobText(FieldName: string): string;
    function FieldIsNull(FieldName: string): boolean;
    function FieldAsString(FieldName: string): string;
    function FieldAsDouble(FieldName: string): double;
{    function FieldAsInteger(I: integer): integer;
    function FieldAsBool(I: integer): boolean;
    function FieldAsBlob(I: Integer): TMemoryStream;
    function FieldAsBlobText(I: Integer): string;
    function FieldIsNull(I: integer): boolean;
    function FieldAsString(I: Integer): string;
    function FieldAsDouble(I: Integer): double;
}    function Next: Boolean;
    function Previous: Boolean;
    property EOF: Boolean read GetEOF;
    property BOF: Boolean read GetBOF;
    property Fields[I: Integer]: string read GetFields;
    property FieldByName[FieldName: string]: string read GetFieldByName;
    property FieldIndex[FieldName: string]: integer read GetFieldIndex;
    property Columns[I: Integer]: string 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;

implementation

uses
  strutils;


procedure DisposePointer(ptr: pointer); cdecl;
begin

  if assigned(ptr) then
  begin freemem(ptr) end;

end;

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

constructor TSQLiteDatabase.Create(const FileName: string);
var
  Msg: pchar;
  iResult: integer;
begin
  inherited Create;

  self.fInTrans := false;

  Msg := nil;
  try
    iResult := SQLite3_Open(PChar(FileName), Fdb);

    if iResult <> SQLITE_OK then
    begin
      if Assigned(Fdb) then
      begin
        Msg := Sqlite3_ErrMsg(Fdb);
        raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', [FileName, Msg]);
      end
      else
      begin raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', [FileName]) end;
    end;

    //set a few configs
    self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;');

    //this pragma not recommended and may disappear in future
    //sqlite versions
    //self.ExecSQL('PRAGMA full_column_names = 1;');

  finally
    if Assigned(Msg) then
    begin SQLite3_Free(Msg) end;
  end;


end;


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

destructor TSQLiteDatabase.Destroy;
begin

  if self.fInTrans then
  begin self.ExecSQL('ROLLBACK;') end; //assume rollback

  if Assigned(fDB) then
  begin SQLite3_Close(fDB) end;

  inherited;
end;

function TSQLiteDatabase.GetLastInsertRowID: int64;
begin
  result := Sqlite3_LastInsertRowID(self.fDB);
end;

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

procedure TSQLiteDatabase.RaiseError(s: string; SQL: string);
//look up last error and raise and exception with an appropriate message
var
  Msg: PChar;
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: string);
var
  Stmt: TSQLiteStmt;
  NextSQLStatement: Pchar;
  iStepResult: integer;
begin
  try

    if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then
    begin RaiseError('Error executing SQL', SQL) end;

    if (Stmt = nil) then
    begin RaiseError('Could not prepare SQL statement', SQL) end;

    iStepResult := Sqlite3_step(Stmt);

    if (iStepResult <> SQLITE_DONE) then
    begin RaiseError('Error executing SQL statement', SQL) end;

  finally

    if Assigned(Stmt) then
    begin Sqlite3_Finalize(stmt) end;

  end;
end;

procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream);
var
  iSize: integer;
  ptr: pointer;
  Stmt: TSQLiteStmt;
  Msg: Pchar;
  NextSQLStatement: Pchar;
  iStepResult: integer;
  iBindResult: integer;
begin
//expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1'

  if pos('?', SQL) = 0 then
  begin RaiseError('SQL must include a ? parameter', SQL) end;

  Msg := nil;
  try

    if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then
    begin RaiseError('Could not prepare SQL statement', SQL) end;

    if (Stmt = nil) then
    begin RaiseError('Could not prepare SQL statement', SQL) end;

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

    GetMem(ptr, iSize);

    if (ptr = nil) then
    begin raise ESqliteException.CreateFmt('Error getting memory to save blob', [SQL, 'Error']) end;

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

    iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer);

    if iBindResult <> SQLITE_OK then
    begin RaiseError('Error binding blob to database', SQL) end;

    iStepResult := Sqlite3_step(Stmt);

    if (iStepResult <> SQLITE_DONE) then
    begin RaiseError('Error executing SQL statement', SQL) end;

  finally

    if Assigned(Stmt) then
    begin Sqlite3_Finalize(stmt) end;

    if Assigned(Msg) then
    begin SQLite3_Free(Msg) end;
  end;

end;

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

function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable;
begin
  Result := TSQLiteTable.Create(Self, SQL);
end;

procedure TSQLiteDatabase.BeginTransaction;
begin
  if not self.fInTrans then
  begin
    self.ExecSQL('BEGIN TRANSACTION;');
    self.fInTrans := true;
  end
  else
  begin raise ESqliteException.Create('Transaction already open') end;
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: string): boolean;
var
  sql: string;
  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) + ''' ';

  try

    ds := self.GetTable(sql);

    result := (ds.Count > 0);

  finally

    freeandnil(ds);

  end;

end;


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

constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string);
var
  Stmt: TSQLiteStmt;
  NextSQLStatement: Pchar;
  iStepResult: integer;

  ptr: pointer;
  iNumBytes: integer;
  thisBlobValue: TMemoryStream;
  thisStringValue: pstring;
  thisBoolValue: pBoolean;
  thisDoubleValue: pDouble;
  thisIntValue: pInteger;
  thisColType: pInteger;
  i: integer;
  DeclaredColType: Pchar;
  ActualColType: integer;
  ptrValue: Pchar;

begin

  try

    self.fRowCount := 0;
    self.fColCount := 0;

//if there are several SQL statements in SQL, NextSQLStatment points to the
//beginning of the next one. Prepare only prepares the first SQL statement.

    if Sqlite3_Prepare(Db.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then
    begin Db.RaiseError('Error executing SQL', SQL) end;

    if (Stmt = nil) then
    begin Db.RaiseError('Could not prepare SQL statement', SQL) end;

    iStepResult := Sqlite3_step(Stmt);

    while (iStepResult <> SQLITE_DONE) do
    begin

      case iStepResult of
        SQLITE_ROW:
          begin

            inc(fRowCount);

            if (fRowCount = 1) then
            begin
     //get data types
              fCols := TStringList.Create;
              fCols.CaseSensitive := False;
              fColTypes := TList.Create;

              fColCount := SQLite3_ColumnCount(stmt);

              for i := 0 to Pred(fColCount) do
              begin
                fCols.Add(Sqlite3_ColumnName(stmt, i));
              end;

              for i := 0 to Pred(fColCount) do
              begin

                new(thisColType);
                DeclaredColType := Sqlite3_ColumnDeclType(stmt, i);

                if DeclaredColType = nil then begin
                //use the actual column type instead
                //seems to be needed for last_insert_rowid
                  thisColType^ := Sqlite3_ColumnType(stmt, i);
                end else begin
                  DeclaredColType := strupper(DeclaredColType);
                  
                  if DeclaredColType = 'INTEGER' then
                  begin thisColType^ := dtInt end
                  else
                    if DeclaredColType = 'BOOLEAN' then
                    begin thisColType^ := dtBool end
                    else
                      if (DeclaredColType = 'NUMERIC') or (DeclaredColType = 'FLOAT') or (DeclaredColType = 'DOUBLE') then
                      begin thisColType^ := dtNumeric end
                      else
                        if DeclaredColType = 'BLOB' then
                        begin thisColType^ := dtBlob end
                        else
                        begin thisColType^ := dtStr end;
                  end;

                fColTypes.Add(thiscoltype);
              end;

              fResults := TList.Create;

            end;

     //get column values
            for i := 0 to Pred(ColCount) do
            begin

              ActualColType := Sqlite3_ColumnType(stmt, i);
              if (ActualColType = SQLITE_NULL) then
              begin fResults.Add(nil) end
              else
              begin
                if pInteger(fColTypes[i])^ = dtInt then
                begin
                  new(thisintvalue);
                  thisintvalue^ := Sqlite3_ColumnInt(stmt, i);
                  fResults.Add(thisintvalue);
                end
                else
                  if pInteger(fColTypes[i])^ = dtBool then
                  begin
                    new(thisboolvalue);
                    thisboolvalue^ := not (Sqlite3_ColumnInt(stmt, i) = 0);
                    fResults.Add(thisboolvalue);
                  end
                  else
                    if pInteger(fColTypes[i])^ = dtNumeric then
                    begin
                      new(thisdoublevalue);
                      thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i);
                      fResults.Add(thisdoublevalue);
                    end
                    else
                      if pInteger(fColTypes[i])^ = dtBlob then
                      begin
                        iNumBytes := Sqlite3_ColumnBytes(stmt, i);

                        if iNumBytes = 0 then
                        begin thisblobvalue := nil end
                        else
                        begin
                          thisblobvalue := TMemoryStream.Create;
                          thisblobvalue.position := 0;
                          ptr := Sqlite3_ColumnBlob(stmt, i);
                          thisblobvalue.writebuffer(ptr^, iNumBytes);
                        end;
                        fResults.Add(thisblobvalue);

                      end
                      else
                      begin
                        new(thisstringvalue);
                        ptrValue := Sqlite3_ColumnText(stmt, i);
                        setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue));
                        fResults.Add(thisstringvalue);
                      end;
              end;

            end;



          end;

        SQLITE_BUSY:
          begin raise ESqliteException.CreateFmt('Could not prepare SQL statement', [SQL, 'SQLite is Busy']) end;
      else
        begin Db.RaiseError('Could not retrieve data', SQL) end;
      end;

      iStepResult := Sqlite3_step(Stmt);

    end;

    fRow := 0;

  finally
    if Assigned(Stmt) then
    begin Sqlite3_Finalize(stmt) end;
  end;

end;

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

destructor TSQLiteTable.Destroy;
var i: integer;
  iColNo: integer;
begin


  if Assigned(fResults) then
  begin for i := 0 to fResults.Count - 1 do
    begin
    //check for blob type
      iColNo := (i mod fColCount);
      case pInteger(self.fColTypes[iColNo])^ of
      dtBlob:
          begin
          TMemoryStream(fResults[i]).free;
          end;
      dtStr:
          begin
           if fResults[i] <> nil then
           begin
               setstring(string(fResults[i]^), nil, 0);
               dispose(fResults[i]);
           end;
          end;
      else
        begin
        dispose(fResults[i])
        end;
      end;
    end;
    fResults.Free;
   end;

    if Assigned(fCols) then
    begin fCols.Free end;

    if Assigned(fColTypes) then
    begin for i := 0 to fColTypes.Count - 1 do
      begin
        dispose(fColTypes[i]);
      end end;
    fColTypes.Free;
    inherited;
  end;

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

function TSQLiteTable.GetColumns(I: Integer): string;
begin
  Result := fCols[I];
end;

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

function TSQLiteTable.GetCountResult: Integer;
begin
  if not EOF then
  begin Result := StrToInt(Fields[0]) end
  else
  begin Result := 0 end;
end;

function TSQLiteTable.GetCount: Integer;
begin
  Result := FRowCount;
end;

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

function TSQLiteTable.GetEOF: Boolean;
begin
  Result := fRow >= fRowCount;
end;

function TSQLiteTable.GetBOF: Boolean;
begin
  Result := fRow <= 0;
end;

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

function TSQLiteTable.GetFieldByName(FieldName: string): string;
begin
  Result := GetFields(self.GetFieldIndex(FieldName));
end;

function TSQLiteTable.GetFieldIndex(FieldName: string): integer;
begin

  if (fCols = nil) then
  begin
    raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset');
    exit;
  end;

  if (fCols.count = 0) then
  begin
    raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset');
    exit;
  end;

  result := fCols.IndexOf(FieldName);

  if (result < 0) then
  begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end;

end;

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

function TSQLiteTable.GetFields(I: Integer): string;
var
  thisvalue: pstring;
  ptr: pointer;
  thisboolvalue: pBoolean;
  thistype: integer;
begin
  Result := '';

  if EOF then
  begin raise ESqliteException.Create('Table is at End of File') end;

//integer and boolean types are not stored in the resultset
//as strings, so they should be retrieved using the type-specific
//methods

  thistype := pInteger(self.fColTypes[I])^;

  if (thistype = dtInt) or (thistype = dtNumeric) or (thistype = dtBlob) then
  begin
    ptr := self.fResults[(self.frow * self.fColCount) + I];

    if ptr <> nil then
    begin
      raise ESqliteException.Create('Use the specific methods for integer, numeric or blob fields');
    end;

  end
  else
    if pInteger(self.fColTypes[I])^ = dtBool then
    begin
      thisboolvalue := self.fResults[(self.frow * self.fColCount) + I];
      if thisboolvalue <> nil then
      begin if thisboolvalue^ then
        begin result := '1' end
        else
        begin result := '0' end end;
    end

    else

    begin

      thisvalue := self.fResults[(self.frow * self.fColCount) + I];
      if (thisvalue <> nil) then
      begin Result := thisvalue^ end
      else
      begin Result := '' end; //return empty string
    end;

end;

function TSqliteTable.FieldAsBlob(FieldName: string): TMemoryStream;
var
  i: Integer;
begin

  if EOF then
  begin raise ESqliteException.Create('Table is at End of File') end;

  i:=Self.FieldIndex[FieldName];

  if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
  begin result := nil end
  else
    if pInteger(self.fColTypes[I])^ = dtBlob then
    begin result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) end
    else
    begin raise ESqliteException.Create('Not a Blob field') end;
end;

function TSqliteTable.FieldAsBlobText(FieldName: string): string;
var
  MemStream: TMemoryStream;
  Buffer: PChar;
begin
  result := '';

  MemStream := self.FieldAsBlob(FieldName);

  if MemStream <> nil then
  begin if MemStream.Size > 0 then
    begin
      MemStream.position := 0;

      Buffer := stralloc(MemStream.Size + 1);
      MemStream.readbuffer(Buffer[0], MemStream.Size);
      (Buffer + MemStream.Size)^ := chr(0);
      SetString(Result, Buffer, MemStream.size);
      strdispose(Buffer);
    end end;

end;


function TSqliteTable.FieldAsInteger(FieldName: string): integer;
var
  i: Integer;
begin

  if EOF then
  begin raise ESqliteException.Create('Table is at End of File') end;

  i:=Self.FieldIndex[FieldName];

  if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
  begin result := 0 end
  else
    if pInteger(self.fColTypes[I])^ = dtInt then
    begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end
    else
      if pInteger(self.fColTypes[I])^ = dtNumeric then
      begin result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) end
      else
      begin raise ESqliteException.Create('Not an integer or numeric field') end;

end;

function TSqliteTable.FieldAsDouble(FieldName: string): double;
var
  i: Integer;
begin

  if EOF then
  begin raise ESqliteException.Create('Table is at End of File') end;

  i:=Self.FieldIndex[FieldName];

  if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
  begin result := 0 end
  else
    if pInteger(self.fColTypes[I])^ = dtInt then
    begin result := pInteger(self.fResults[(self.frow * self.fColCount) + I])^ end
    else
      if pInteger(self.fColTypes[I])^ = dtNumeric then
      begin result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ end
      else
      begin raise ESqliteException.Create('Not an integer or numeric field') end;

end;

function TSqliteTable.FieldAsBool(FieldName: string): boolean;
var
  i: Integer;
begin

  if EOF then
  begin raise ESqliteException.Create('Table is at End of File') end;

  i:=Self.FieldIndex[FieldName];

  if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
  begin result := false end
  else
    if pInteger(self.fColTypes[I])^ = dtBool then
    begin result := pBoolean(self.fResults[(self.frow * self.fColCount) + I])^ end
    else
    begin raise ESqliteException.Create('Not a boolean field') end;
end;

function TSqliteTable.FieldAsString(FieldName: string): string;
var
  i: Integer;
begin

  if EOF then
  begin raise ESqliteException.Create('Table is at End of File') end;

  i:=Self.FieldIndex[FieldName];

  if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
  begin result := '' end
  else
  begin result := self.GetFields(I) end;

end;

function TSqliteTable.FieldIsNull(FieldName: string): boolean;
var
  thisvalue: pointer;
  i: Integer;
begin

  if EOF then
  begin raise ESqliteException.Create('Table is at End of File') end;

  i:=Self.FieldIndex[FieldName];

  thisvalue := self.fResults[(self.frow * self.fColCount) + I];
  result := (thisvalue = nil);
end;

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

function TSQLiteTable.Next: boolean;
begin
  result := false;
  if not EOF then
  begin
    Inc(fRow);
    result := true;
  end;
end;

function TSQLiteTable.Previous: boolean;
begin
  result := false;
  if not BOF then
  begin
    Dec(fRow);
    result := true;
  end;
end;

function TSQLiteTable.MoveFirst: boolean;
begin
  result := false;
  if self.fRowCount > 0 then
  begin
    fRow := 0;
    result := true;
  end;
end;

function TSQLiteTable.MoveLast: boolean;
begin
  result := false;
  if self.fRowCount > 0 then
  begin
    fRow := fRowCount - 1;
    result := true;
  end;
end;


end.