diff options
Diffstat (limited to '')
-rw-r--r-- | Game/Code/lib/SQLite/SQLiteTable3.pas | 1535 |
1 files changed, 770 insertions, 765 deletions
diff --git a/Game/Code/lib/SQLite/SQLiteTable3.pas b/Game/Code/lib/SQLite/SQLiteTable3.pas index e09cc7a0..05fbd573 100644 --- a/Game/Code/lib/SQLite/SQLiteTable3.pas +++ b/Game/Code/lib/SQLite/SQLiteTable3.pas @@ -1,765 +1,770 @@ -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)
- Modified and enhanced by Lukas Gebauer
-}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-uses
- Windows, SQLite3, Classes, SysUtils;
-
-const
-
- dtInt = 1;
- dtNumeric = 2;
- dtStr = 3;
- dtBlob = 4;
- dtNull = 5;
-
-type
-
- ESQLiteException = class(Exception)
- 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);
- function GetTableValue(const SQL: string): int64;
- function GetTableString(const SQL: string): string;
- procedure UpdateBlob(const SQL: string; BlobData: TStream);
- procedure BeginTransaction;
- procedure Commit;
- procedure Rollback;
- function TableExists(TableName: string): boolean;
- function GetLastInsertRowID: int64;
- procedure SetTimeout(Value: integer);
- function version: string;
- 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: cardinal): 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(I: cardinal): int64;
- function FieldAsBlob(I: cardinal): TMemoryStream;
- function FieldAsBlobText(I: cardinal): string;
- function FieldIsNull(I: cardinal): boolean;
- function FieldAsString(I: cardinal): string;
- 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]: 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
-
-procedure DisposePointer(ptr: pointer); cdecl;
-begin
- if assigned(ptr) then
- freemem(ptr);
-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
- 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]);
-
- //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 Assigned(fDB) then
- SQLite3_Close(fDB);
-
- 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 an 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
- 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: 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
- RaiseError('SQL must include a ? parameter', SQL);
-
- Msg := nil;
- try
-
- if Sqlite3_Prepare(self.fDB, PChar(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_BindBlob(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: string): TSQLiteTable;
-begin
- Result := TSQLiteTable.Create(Self, SQL);
-end;
-
-function TSQLiteDatabase.GetTableValue(const SQL: string): int64;
-var
- Table: TSQLiteTable;
-begin
- Table := self.GetTable(SQL);
- try
- Result := Table.FieldAsInteger(0);
- finally
- Table.Free;
- end;
-end;
-
-function TSQLiteDatabase.GetTableString(const SQL: string): string;
-var
- Table: TSQLiteTable;
-begin
- Table := self.GetTable(SQL);
- try
- 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: 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) + ''' ';
- ds := self.GetTable(sql);
- try
- Result := (ds.Count > 0);
- finally
- ds.Free;
- end;
-end;
-
-procedure TSQLiteDatabase.SetTimeout(Value: integer);
-begin
- SQLite3_BusyTimeout(self.fDB, Value);
-end;
-
-function TSQLiteDatabase.version: string;
-begin
- Result := SQLite3_Version;
-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;
- thisDoubleValue: pDouble;
- thisIntValue: pInt64;
- 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
- DB.RaiseError('Error executing SQL', SQL);
- if (Stmt = nil) then
- DB.RaiseError('Could not prepare SQL statement', SQL);
- 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;
- fColTypes := TList.Create;
- fColCount := SQLite3_ColumnCount(stmt);
- for i := 0 to Pred(fColCount) do
- fCols.Add(AnsiUpperCase(Sqlite3_ColumnName(stmt, i)));
- for i := 0 to Pred(fColCount) do
- begin
- new(thisColType);
- DeclaredColType := Sqlite3_ColumnDeclType(stmt, i);
- if DeclaredColType = nil then
- thisColType^ := Sqlite3_ColumnType(stmt, i) //use the actual column type instead
- //seems to be needed for last_insert_rowid
- else
- if (DeclaredColType = 'INTEGER') or (DeclaredColType = 'BOOLEAN') then
- thisColType^ := dtInt
- else
- if (DeclaredColType = 'NUMERIC') or
- (DeclaredColType = 'FLOAT') or
- (DeclaredColType = 'DOUBLE') or
- (DeclaredColType = 'REAL') then
- thisColType^ := dtNumeric
- else
- if DeclaredColType = 'BLOB' then
- thisColType^ := dtBlob
- else
- thisColType^ := dtStr;
- 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
- fResults.Add(nil)
- else
- if pInteger(fColTypes[i])^ = dtInt then
- begin
- new(thisintvalue);
- thisintvalue^ := Sqlite3_ColumnInt64(stmt, i);
- fResults.Add(thisintvalue);
- 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
- thisblobvalue := nil
- 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;
- SQLITE_BUSY:
- raise ESqliteException.CreateFmt('Could not prepare SQL statement',
- [SQL, 'SQLite is Busy']);
- else
- DB.RaiseError('Could not retrieve data', SQL);
- end;
- iStepResult := Sqlite3_step(Stmt);
- end;
- fRow := 0;
- finally
- if Assigned(Stmt) then
- Sqlite3_Finalize(stmt);
- end;
-end;
-
-//..............................................................................
-
-destructor TSQLiteTable.Destroy;
-var
- i: cardinal;
- 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:
- TMemoryStream(fResults[i]).Free;
- dtStr:
- if fResults[i] <> nil then
- begin
- setstring(string(fResults[i]^), nil, 0);
- dispose(fResults[i]);
- end;
- else
- dispose(fResults[i]);
- end;
- end;
- fResults.Free;
- end;
- if Assigned(fCols) then
- fCols.Free;
- if Assigned(fColTypes) then
- for i := 0 to fColTypes.Count - 1 do
- dispose(fColTypes[i]);
- fColTypes.Free;
- inherited;
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetColumns(I: integer): string;
-begin
- Result := fCols[I];
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetCountResult: integer;
-begin
- if not EOF then
- Result := StrToInt(Fields[0])
- else
- Result := 0;
-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(AnsiUpperCase(FieldName));
-
- if (result < 0) then
- begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end;
-
-end;
-
-//..............................................................................
-
-function TSQLiteTable.GetFields(I: cardinal): string;
-var
- thisvalue: pstring;
- thistype: integer;
-begin
- Result := '';
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- //integer types are not stored in the resultset
- //as strings, so they should be retrieved using the type-specific
- //methods
- thistype := pInteger(self.fColTypes[I])^;
-
- case thistype of
- dtStr:
- begin
- thisvalue := self.fResults[(self.frow * self.fColCount) + I];
- if (thisvalue <> nil) then
- Result := thisvalue^
- else
- Result := '';
- end;
- dtInt:
- Result := IntToStr(self.FieldAsInteger(I));
- dtNumeric:
- Result := FloatToStr(self.FieldAsDouble(I));
- dtBlob:
- Result := self.FieldAsBlobText(I);
- else
- Result := '';
- end;
-end;
-
-function TSqliteTable.FieldAsBlob(I: cardinal): TMemoryStream;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := nil
- else
- if pInteger(self.fColTypes[I])^ = dtBlob then
- Result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I])
- else
- raise ESqliteException.Create('Not a Blob field');
-end;
-
-function TSqliteTable.FieldAsBlobText(I: cardinal): string;
-var
- MemStream: TMemoryStream;
- Buffer: PChar;
-begin
- Result := '';
- MemStream := self.FieldAsBlob(I);
- if MemStream <> nil then
- 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;
-
-
-function TSqliteTable.FieldAsInteger(I: cardinal): int64;
-begin
- if EOF then
- //raise ESqliteException.Create('Table is at End of File');
- Result := 0
- else if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := 0
- else
- if pInteger(self.fColTypes[I])^ = dtInt then
- Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^
- else
- if pInteger(self.fColTypes[I])^ = dtNumeric then
- Result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^))
- else
- raise ESqliteException.Create('Not an integer or numeric field');
-end;
-
-function TSqliteTable.FieldAsDouble(I: cardinal): double;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := 0
- else
- if pInteger(self.fColTypes[I])^ = dtInt then
- Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^
- else
- if pInteger(self.fColTypes[I])^ = dtNumeric then
- Result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^
- else
- raise ESqliteException.Create('Not an integer or numeric field');
-end;
-
-function TSqliteTable.FieldAsString(I: cardinal): string;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
- Result := ''
- else
- Result := self.GetFields(I);
-end;
-
-function TSqliteTable.FieldIsNull(I: cardinal): boolean;
-var
- thisvalue: pointer;
-begin
- if EOF then
- raise ESqliteException.Create('Table is at End of File');
- 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.
-
+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) + Modified and enhanced by Lukas Gebauer +} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + {$ifdef win32} + Windows, + {$endif} + SQLite3, + Classes, + SysUtils; + +const + + dtInt = 1; + dtNumeric = 2; + dtStr = 3; + dtBlob = 4; + dtNull = 5; + +type + + ESQLiteException = class(Exception) + 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); + function GetTableValue(const SQL: string): int64; + function GetTableString(const SQL: string): string; + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + procedure SetTimeout(Value: integer); + function version: string; + 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: cardinal): 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(I: cardinal): int64; + function FieldAsBlob(I: cardinal): TMemoryStream; + function FieldAsBlobText(I: cardinal): string; + function FieldIsNull(I: cardinal): boolean; + function FieldAsString(I: cardinal): string; + 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]: 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 + +procedure DisposePointer(ptr: pointer); cdecl; +begin + if assigned(ptr) then + freemem(ptr); +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 + 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]); + + //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 Assigned(fDB) then + SQLite3_Close(fDB); + + 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 an 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 + 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: 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 + RaiseError('SQL must include a ? parameter', SQL); + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(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_BindBlob(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: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +function TSQLiteDatabase.GetTableValue(const SQL: string): int64; +var + Table: TSQLiteTable; +begin + Table := self.GetTable(SQL); + try + Result := Table.FieldAsInteger(0); + finally + Table.Free; + end; +end; + +function TSQLiteDatabase.GetTableString(const SQL: string): string; +var + Table: TSQLiteTable; +begin + Table := self.GetTable(SQL); + try + 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: 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) + ''' '; + ds := self.GetTable(sql); + try + Result := (ds.Count > 0); + finally + ds.Free; + end; +end; + +procedure TSQLiteDatabase.SetTimeout(Value: integer); +begin + SQLite3_BusyTimeout(self.fDB, Value); +end; + +function TSQLiteDatabase.version: string; +begin + Result := SQLite3_Version; +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; + thisDoubleValue: pDouble; + thisIntValue: pInt64; + 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 + DB.RaiseError('Error executing SQL', SQL); + if (Stmt = nil) then + DB.RaiseError('Could not prepare SQL statement', SQL); + 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; + fColTypes := TList.Create; + fColCount := SQLite3_ColumnCount(stmt); + for i := 0 to Pred(fColCount) do + fCols.Add(AnsiUpperCase(Sqlite3_ColumnName(stmt, i))); + for i := 0 to Pred(fColCount) do + begin + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + if DeclaredColType = nil then + thisColType^ := Sqlite3_ColumnType(stmt, i) //use the actual column type instead + //seems to be needed for last_insert_rowid + else + if (DeclaredColType = 'INTEGER') or (DeclaredColType = 'BOOLEAN') then + thisColType^ := dtInt + else + if (DeclaredColType = 'NUMERIC') or + (DeclaredColType = 'FLOAT') or + (DeclaredColType = 'DOUBLE') or + (DeclaredColType = 'REAL') then + thisColType^ := dtNumeric + else + if DeclaredColType = 'BLOB' then + thisColType^ := dtBlob + else + thisColType^ := dtStr; + 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 + fResults.Add(nil) + else + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt64(stmt, i); + fResults.Add(thisintvalue); + 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 + thisblobvalue := nil + 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; + SQLITE_BUSY: + raise ESqliteException.CreateFmt('Could not prepare SQL statement', + [SQL, 'SQLite is Busy']); + else + DB.RaiseError('Could not retrieve data', SQL); + end; + iStepResult := Sqlite3_step(Stmt); + end; + fRow := 0; + finally + if Assigned(Stmt) then + Sqlite3_Finalize(stmt); + end; +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var + i: cardinal; + 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: + TMemoryStream(fResults[i]).Free; + dtStr: + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + else + dispose(fResults[i]); + end; + end; + fResults.Free; + end; + if Assigned(fCols) then + fCols.Free; + if Assigned(fColTypes) then + for i := 0 to fColTypes.Count - 1 do + dispose(fColTypes[i]); + fColTypes.Free; + inherited; +end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: integer; +begin + if not EOF then + Result := StrToInt(Fields[0]) + else + Result := 0; +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(AnsiUpperCase(FieldName)); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: cardinal): string; +var + thisvalue: pstring; + thistype: integer; +begin + Result := ''; + if EOF then + raise ESqliteException.Create('Table is at End of File'); + //integer types are not stored in the resultset + //as strings, so they should be retrieved using the type-specific + //methods + thistype := pInteger(self.fColTypes[I])^; + + case thistype of + dtStr: + begin + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + Result := thisvalue^ + else + Result := ''; + end; + dtInt: + Result := IntToStr(self.FieldAsInteger(I)); + dtNumeric: + Result := FloatToStr(self.FieldAsDouble(I)); + dtBlob: + Result := self.FieldAsBlobText(I); + else + Result := ''; + end; +end; + +function TSqliteTable.FieldAsBlob(I: cardinal): TMemoryStream; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := nil + else + if pInteger(self.fColTypes[I])^ = dtBlob then + Result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) + else + raise ESqliteException.Create('Not a Blob field'); +end; + +function TSqliteTable.FieldAsBlobText(I: cardinal): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + Result := ''; + MemStream := self.FieldAsBlob(I); + if MemStream <> nil then + 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; + + +function TSqliteTable.FieldAsInteger(I: cardinal): int64; +begin + if EOF then + //raise ESqliteException.Create('Table is at End of File'); + Result := 0 + else if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := 0 + else + if pInteger(self.fColTypes[I])^ = dtInt then + Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^ + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + Result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) + else + raise ESqliteException.Create('Not an integer or numeric field'); +end; + +function TSqliteTable.FieldAsDouble(I: cardinal): double; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := 0 + else + if pInteger(self.fColTypes[I])^ = dtInt then + Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^ + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + Result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ + else + raise ESqliteException.Create('Not an integer or numeric field'); +end; + +function TSqliteTable.FieldAsString(I: cardinal): string; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := '' + else + Result := self.GetFields(I); +end; + +function TSqliteTable.FieldIsNull(I: cardinal): boolean; +var + thisvalue: pointer; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + 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. + |