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.