Люди, поделитесь опытом - как подключать/юзать/какие глюки?
С уважением.
Модератор: Модераторы
PVOzerski » 09.10.2005 16:18:52
unit libsqlite3;
{$IFDEF FPC}
{$MODE Delphi}
{$smartlink on}
{$H+}
{$ELSE}
{$IFNDEF LINUX}
{$DEFINE WIN32}
{$ENDIF}
{$ENDIF}
//sqlite3.dll api interface
//initial code by Miha Vrhovnik
//Minimal Changes by PVOzerski
// for documentation on these constants and functions, please look at
// <a href='http://www.sqlite.org/capi3ref.html' target='_blank'>http://www.sqlite.org/capi3ref.html</a>
//I only ported functions with support for 16bit-unicode I know that databases
//take much more space if texts in fields are mostly from ASCII table but it's easier to work with
//especialy if you have texts form other languages andy so you don't have to convert to from utf8 string each time
interface
uses {$IFNDEF LINUX}{$IFDEF FPC}DynLibs{$ELSE}Windows{$ENDIF}{$ELSE}SysUtils{$ENDIF};
{$IFDEF FPC}
type
PWChar = PWideChar;
{$ENDIF}
const SQLITE_OK = 0; // Successful result
const SQLITE_ERROR = 1; // SQL error or missing database
const SQLITE_INTERNAL = 2; // An internal logic error in SQLite
const SQLITE_PERM = 3; // Access permission denied
const SQLITE_ABORT = 4; // Callback routine requested an abort
const SQLITE_BUSY = 5; // The database file is locked
const SQLITE_LOCKED = 6; // A table in the database is locked
const SQLITE_NOMEM = 7; // A malloc() failed
const SQLITE_READONLY = 8; // Attempt to write a readonly database
const SQLITE_INTERRUPT = 9; // Operation terminated by sqlite_interrupt()
const SQLITE_IOERR = 10; // Some kind of disk I/O error occurred
const SQLITE_CORRUPT = 11; // The database disk image is malformed
const SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found
const SQLITE_FULL = 13; // Insertion failed because database is full
const SQLITE_CANTOPEN = 14; // Unable to open the database file
const SQLITE_PROTOCOL = 15; // Database lock protocol error
const SQLITE_EMPTY = 16; // (Internal Only) Database table is empty
const SQLITE_SCHEMA = 17; // The database schema changed
const SQLITE_TOOBIG = 18; // Too much data for one row of a table
const SQLITE_CONSTRAINT = 19; // Abort due to contraint violation
const SQLITE_MISMATCH = 20; // Data type mismatch
const SQLITE_MISUSE = 21; // Library used incorrectly
const SQLITE_NOLFS = 22; // Uses OS features not supported on host
const SQLITE_AUTH = 23; // Authorization denied
const SQLITE_ROW = 100; // sqlite_step() has another row ready
const SQLITE_DONE = 101; // sqlite_step() has finished executing
{
These are the allowed values for the eTextRep argument to
sqlite3_create_collation and sqlite3_create_function.
}
const SQLITE_UTF8 = 1;
const SQLITE_UTF16LE = 2;
const SQLITE_UTF16BE = 3;
const SQLITE_UTF16 = 4; // Use native byte order
const SQLITE_ANY = 5;
//values returned by SQLite3_Column_Type
const SQLITE_INTEGER = 1;
const SQLITE_FLOAT = 2;
const SQLITE_TEXT = 3;
const SQLITE_BLOB = 4;
const SQLITE_NULL = 5;
const SQLITEDLL: PChar = {$IFDEF LINUX}'libsqlite3.so' {$ELSE} 'sqlite3.dll'{$ENDIF};
function LoadLibSqlite3(libraryName: String = ''): Boolean;
type PSQLite = Pointer;
TSqlite_Func = record
P:Pointer;
end;
PSQLite_Func = ^TSQLite_Func;
//untested:
//procProgressCallback = procedure (UserData:Integer); cdecl;
//untested:
//Tsqlite_create_function= function (db: Pointer; {const}zName:PChar; nArg: Integer; xFunc : PSqlite_func{*,int,const char**};
// UserData: Integer):Integer; cdecl;
//void *sqlite3_aggregate_context(sqlite3_context*, int nBytes);
(*Aggregate functions use the following routine to allocate a structure for storing their state. The first time this routine is called for a particular aggregate, a new structure of size nBytes is allocated, zeroed, and returned. On subsequent calls (for the same aggregate instance) the same buffer is returned. The implementation of the aggregate can use the returned buffer to accumulate data.
The buffer allocated is freed automatically by SQLite*)
//int sqlite3_aggregate_count(sqlite3_context*);
(*
The next routine returns the number of calls to xStep for a particular aggregate function instance. The current call to xStep counts so this routine always returns at least 1.
*)
{ int sqlite3_bind_blob(sqlite3_stmt*, int, const void*, int n, void(*)(void*));
int sqlite3_bind_double(sqlite3_stmt*, int, double);
int sqlite3_bind_int(sqlite3_stmt*, int, int);
int sqlite3_bind_int64(sqlite3_stmt*, int, long long int);
int sqlite3_bind_null(sqlite3_stmt*, int);
int sqlite3_bind_text(sqlite3_stmt*, int, const char*, int n, void(*)(void*));
int sqlite3_bind_text16(sqlite3_stmt*, int, const void*, int n, void(*)(void*));
#define SQLITE_STATIC ((void(*)(void *))0)
#define SQLITE_TRANSIENT ((void(*)(void *))-1)
}
(*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. The value of these wildcard literals can be set using these routines.
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 after sqlite3_prepare() or sqlite3_reset() and before sqlite3_step(). Bindings are not reset by the sqlite3_reset() routine. Unbound wildcards are interpreted as NULL.
*)
var SQLite3_BindParameterCount: function(hstatement: Pointer): Integer; cdecl;
var SQLite3_BindParameterName: function(hstatement: Pointer; paramNo: Integer): PChar; cdecl;
var SQLite3_BusyHandler: procedure(db: Pointer; CallbackPtr: Pointer; Sender: TObject); cdecl;
var SQLite3_BusyTimeout: procedure(db: Pointer; TimeOut: Integer); cdecl;
var SQLite3_Changes: function(db: Pointer): Integer; cdecl;
var SQLite3_Close: function (db: Pointer): Integer; cdecl;
//CollationFunction is defined as function ColFunc(pCollNeededArg: Pointer; db: Pointer; eTextRep: Integer; CollSeqName: PChar): Pointer;
//pCollNeededArg <- what is that?
var SQlite_Collation_Needed: function(db: Pointer; pCollNeededArg: Pointer; CollationFunctionPtr: Pointer): Integer; cdecl;
var SQlite_Collation_Needed16: function(db: Pointer; pCollNeededArg: Pointer; CollationFunctionPtr: Pointer): Integer; cdecl;
var SQLite3_Column_Blob: function(hstatement: Pointer; iCol: Integer): Pointer; cdecl;
var SQLite3_Column_Bytes: function(hstatement: Pointer; iCol: Integer): Integer; cdecl;
var SQLite3_Column_Bytes16: function(hstatement: Pointer; iCol: Integer): Integer; cdecl;
var SQLite3_Column_Count: function(hstatement: Pointer): Integer; cdecl;
var SQLite3_Column_Double: function(hstatement: Pointer; iCol: Integer): Double; cdecl;
var SQLite3_Column_Int: function(hstatement: Pointer; iCol: Integer): Integer; cdecl;
var SQLite3_Column_Int64: function(hstatement: Pointer; iCol: Integer): Int64; cdecl;
var SQLite3_Column_Text: function(hstatement: Pointer; iCol: Integer): PChar; cdecl;
var SQLite3_Column_Text16: function(hstatement: Pointer; iCol: Integer): PWChar; cdecl;
var SQLite3_Column_Type: function(hstatement: Pointer; iCol: Integer): Integer; cdecl;
var SQLite3_Column_Decltype: function(hstatement: Pointer; iCol: Integer): PChar; cdecl;
var SQLite3_Column_Decltype16: function (hstatement: Pointer; colNo: Integer): PWChar; cdecl;
var SQLite3_Column_Name: function(hstatement: Pointer; iCol: Integer): PChar; cdecl;
var SQLite3_Column_Name16: function (hstatement: Pointer; colNo: Integer): PWChar; cdecl;
{void *sqlite3_commit_hook(sqlite3*, int(*xCallback)(void*), void *pArg);}
(*
Experimental
Register a callback function to be invoked whenever a new transaction is committed. The pArg argument is passed through to the callback. callback. If the callback function returns non-zero, then the commit is converted into a rollback.
If another function was previously registered, its pArg value is returned. Otherwise NULL is returned.
Registering a NULL function disables the callback. Only a single commit hook callback can be registered at a time.
*)
var SQLite3_Complete: function(const sql: PChar): Integer; cdecl;
var SQLite3_Complete16: function(const sql: PWChar): Integer; cdecl;
//CompareFunction is defined as function ComFunc(pCtx: Pointer; str1Length: Integer; str1: PWChar; str2Length: Integer; str2: PWChar): Pointer;
//pCtx <- what is that?
var SQLite3_Create_Collation: function(db: Pointer; CollName: PChar; eTextRep: Integer; pCtx: Pointer; compareFuncPtr: Pointer): Integer; cdecl;
var SQLite3_Create_Collation16: function(db: Pointer; CollName: PWChar; eTextRep: Integer; pCtx: Pointer; compareFuncPtr: Pointer): Integer; cdecl;
{int sqlite3_create_function16(
sqlite3*,
const void *zFunctionName,
int nArg,
int eTextRep,
void*,
void (*xFunc)(sqlite3_context*,int,sqlite3_value**),
void (*xStep)(sqlite3_context*,int,sqlite3_value**),
void (*xFinal)(sqlite3_context*)
);}
(* These two functions are used to add user functions or aggregates implemented in C to the SQL langauge interpreted by SQLite. The difference only between the two is that the second parameter, the name of the (scalar) function or aggregate, is encoded in UTF-8 for sqlite3_create_function() and UTF-16 for sqlite3_create_function16().
The first argument is the database handle that the new function or aggregate is to be added to. If a single program uses more than one database handle internally, then user functions or aggregates must be added individually to each database handle with which they will be used.
The third parameter is the number of arguments that the function or aggregate takes. If this parameter is negative, then the function or aggregate may take any number of arguments.
The sixth, seventh and eighth, xFunc, xStep and xFinal, are pointers to user implemented C functions that implement the user function or aggregate. A scalar function requires an implementation of the xFunc callback only, NULL pointers should be passed as the xStep and xFinal parameters. An aggregate function requires an implementation of xStep and xFinal, but NULL should be passed for xFunc. To delete an existing user function or aggregate, pass NULL for all three function callback. Specifying an inconstent set of callback values, such as an xFunc and an xFinal, or an xStep but no xFinal, SQLITE_ERROR is returned.
*)
var SQLite3_Data_Count: function(hstatement: Pointer): Integer; cdecl;
var SQLite3_ErrCode: function(db: Pointer): Integer; cdecl;
var SQLite3_ErrorMsg: function(db : Pointer): PChar; cdecl;
var SQLite3_ErrorMsg16: function(db : Pointer): PWChar; cdecl;
var SQLite3_Exec: function(db: Pointer; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): Integer; cdecl;
var SQLite3_Finalize: function(hstatement: Pointer): Integer; cdecl;
var SQLite3_Free: procedure(P: PChar); cdecl;
var SQLite3_GetTable: function(db: Pointer; SQLStatement: PChar; var ResultPtr: Pointer; var RowCount: Integer; var ColCount: Integer; var ErrMsg: PChar): Integer; cdecl;
var SQLite3_FreeTable: procedure(Table: PChar); cdecl;
var SQLite3_Interrupt: procedure(db : Pointer); cdecl;
var SQLite3_LastInsertRowId: function(db: Pointer): Int64; cdecl;
var SQLite3_LibVersion: function(): PChar; cdecl;
{char *sqlite3_mprintf(const char*,...);
char *sqlite3_vmprintf(const char*, va_list);
}
(* These routines are variants of the "sprintf()" from the standard C library. The resulting string is written into memory obtained from malloc() so that there is never a possiblity of buffer overflow. These routines also implement some additional formatting options that are useful for constructing SQL statements.
The strings returned by these routines should be freed by calling sqlite3_free().
All of the usual printf formatting options apply. In addition, there is a "%q" option. %q works like %s in that it substitutes a null-terminated string from the argument list. But %q also doubles every '\'' character. %q is designed for use inside a string literal. By doubling each '\'' character it escapes that character and allows it to be inserted into the string.
For example, so some string variable contains text as follows:
char *zText = "It's a happy day!";
One can use this text in an SQL statement as follows:
sqlite3_exec_printf(db, "INSERT INTO table VALUES('%q')",
callback1, 0, 0, zText);
Because the %q format string is used, the '\'' character in zText is escaped and the SQL generated is as follows:
INSERT INTO table1 VALUES('It''s a happy day!')
This is correct. Had we used %s instead of %q, the generated SQL would have looked like this:
INSERT INTO table1 VALUES('It's a happy day!');
This second example is an SQL syntax error. As a general rule you should always use %q instead of %s when inserting text into a string literal.
*)
var SQLite3_Open: function(dbName: PChar; var db: Pointer): Integer; cdecl;
var SQLite3_Open16: function(dbName: PWChar; var db: Pointer): Integer; cdecl;
var SQLite3_Prepare: function(db: Pointer; SQLStatement: PChar; SQLLength: Integer; var hstatement: Pointer; var Tail: pointer): Integer; cdecl;
var SQLite3_Prepare16: function(db: Pointer; SQLStatement: PWChar; SQLLength: Integer; var hstatement: Pointer; var Tail: pointer): Integer; cdecl;
{void sqlite3_progress_handler(sqlite3*, int, int(*)(void*), void*);}
(* Experimental
This routine configures a callback function - the progress callback - that is invoked periodically during long running calls to sqlite3_exec(), sqlite3_step() and sqlite3_get_table(). An example use for this API is to keep a GUI updated during a large query.
The progress callback is invoked once for every N virtual machine opcodes, where N is the second argument to this function. The progress callback itself is identified by the third argument to this function. The fourth argument to this function is a void pointer passed to the progress callback function each time it is invoked.
If a call to sqlite3_exec(), sqlite3_step() or sqlite3_get_table() results in less than N opcodes being executed, then the progress callback is not invoked.
To remove the progress callback altogether, pass NULL as the third argument to this function.
If the progress callback returns a result other than 0, then the current query is immediately terminated and any database changes rolled back. If the query was part of a larger transaction, then the transaction is not rolled back and remains active. The sqlite3_exec() call returns SQLITE_ABORT.
*)
var SQLite3_Reset: function(hstatement: Pointer): Integer; cdecl;
{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*);
}
(*User-defined functions invoke the following routines in order to set their return value. The sqlite3_result_value() routine is used to return an exact copy of one of the parameters to the function.
The operation of these routines is very similar to the operation of sqlite3_bind_blob() and its cousins. Refer to the documentation there for additional information.
*)
{int sqlite3_set_authorizer(
sqlite3*,
int (*xAuth)(void*,int,const char*,const char*,const char*,const char*),
void *pUserData
);
}
(*#define SQLITE_CREATE_INDEX 1 // Index Name Table Name
#define SQLITE_CREATE_TABLE 2 // Table Name NULL
#define SQLITE_CREATE_TEMP_INDEX 3 // Index Name Table Name
#define SQLITE_CREATE_TEMP_TABLE 4 // Table Name NULL
#define SQLITE_CREATE_TEMP_TRIGGER 5 // Trigger Name Table Name
#define SQLITE_CREATE_TEMP_VIEW 6 // View Name NULL
#define SQLITE_CREATE_TRIGGER 7 // Trigger Name Table Name
#define SQLITE_CREATE_VIEW 8 // View Name NULL
#define SQLITE_DELETE 9 // Table Name NULL
#define SQLITE_DROP_INDEX 10 // Index Name Table Name
#define SQLITE_DROP_TABLE 11 // Table Name NULL
#define SQLITE_DROP_TEMP_INDEX 12 // Index Name Table Name
#define SQLITE_DROP_TEMP_TABLE 13 // Table Name NULL
#define SQLITE_DROP_TEMP_TRIGGER 14 // Trigger Name Table Name
#define SQLITE_DROP_TEMP_VIEW 15 // View Name NULL
#define SQLITE_DROP_TRIGGER 16 // Trigger Name Table Name
#define SQLITE_DROP_VIEW 17 // View Name NULL
#define SQLITE_INSERT 18 // Table Name NULL
#define SQLITE_PRAGMA 19 // Pragma Name 1st arg or NULL
#define SQLITE_READ 20 // Table Name Column Name
#define SQLITE_SELECT 21 // NULL NULL
#define SQLITE_TRANSACTION 22 // NULL NULL
#define SQLITE_UPDATE 23 // Table Name Column Name
#define SQLITE_ATTACH 24 // Filename NULL
#define SQLITE_DETACH 25 // Database Name NULL
#define SQLITE_DENY 1 // Abort the SQL statement with an error
#define SQLITE_IGNORE 2 // Don't allow access, but don't generate an error
This routine registers a callback with the SQLite library. The callback is invoked (at compile-time, not at run-time) for each attempt to access a column of a table in the database. The callback should return SQLITE_OK if access is allowed, SQLITE_DENY if the entire SQL statement should be aborted with an error and SQLITE_IGNORE if the column should be treated as a NULL value.
The second parameter to the access authorization function above will be one of the values below. These values signify what kind of operation is to be authorized. The 3rd and 4th parameters to the authorization function will be parameters or NULL depending on which of the following codes is used as the second parameter. The 5th parameter is the name of the database ("main", "temp", etc.) if applicable. The 6th parameter is the name of the inner-most trigger or view that is responsible for the access attempt or NULL if this access attempt is directly from input SQL code.
The return value of the authorization function should be one of the constants SQLITE_OK, SQLITE_DENY, or SQLITE_IGNORE.
The intent of this routine is to allow applications to safely execute user-entered SQL. An appropriate callback can deny the user-entered SQL access certain operations (ex: anything that changes the database) or to deny access to certain tables or columns within the database.
*)
var SQLite3_Step: function(hstatement: Pointer): Integer; cdecl;
var SQLite3_Total_Changes: function(db: Pointer): Integer; cdecl;
{void *sqlite3_trace(sqlite3*, void(*xTrace)(void*,const char*), void*);
}
(*Register a function that is called at every invocation of sqlite3_exec() or sqlite3_prepare(). This function can be used (for example) to generate a log file of all SQL executed against a database. This is frequently useful when debugging an application that uses SQLite.
*)
{void *sqlite3_user_data(sqlite3_context*);}
(*The pUserData parameter to the sqlite3_create_function() and sqlite3_create_function16() routines used to register user functions is available to the implementation of the function using this call.
*)
{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*);
}
(*This group of routines returns information about parameters to a user-defined function. Function implementations use these routines to access their parameters. These routines are the same as the sqlite3_column_... routines except that these routines take a single sqlite3_value* pointer instead of an sqlite3_stmt* and an integer column number.
See the documentation under sqlite3_column_blob for additional information.
*)
///////////////////////
//untested:
//sqlite_progress_handler: procedure (db: Pointer; VMCyclesPerCallback: Integer; ProgressCallBack: Pointer; UserData: Integer{? Pointer?}); cdecl;
Libs3Loaded: Boolean=False;
DLLHandle: THandle;
MsgNoError: String;
implementation
{$IFDEF FPC}
//FPC Support function helping typecasting:
function GetProcAddress(hModule: HMODULE; lpProcName: PChar): Pointer;
begin
Result := GetProcedureAddress(hModule, lpProcName);
end;
{$ENDIF}
function LoadLibSqlite3(libraryName: String): Boolean;
begin
if libraryName = '' then
libraryName := SQLITEDLL;
Result := Libs3Loaded;
if Result then //already loaded.
exit;
// DLLHandle := GetModuleHandle(PChar(libraryName));
DLLHandle := LoadLibrary(PChar(libraryName));
if DLLHandle <> 0 then
begin
Result := True; //assume everything ok unless..
//void *sqlite3_aggregate_context(sqlite3_context*, int nBytes);
{ int sqlite3_bind_blob(sqlite3_stmt*, int, const void*, int n, void(*)(void*));
int sqlite3_bind_double(sqlite3_stmt*, int, double);
int sqlite3_bind_int(sqlite3_stmt*, int, int);
int sqlite3_bind_int64(sqlite3_stmt*, int, long long int);
int sqlite3_bind_null(sqlite3_stmt*, int);
int sqlite3_bind_text(sqlite3_stmt*, int, const char*, int n, void(*)(void*));
int sqlite3_bind_text16(sqlite3_stmt*, int, const void*, int n, void(*)(void*));
#define SQLITE_STATIC ((void(*)(void *))0)
#define SQLITE_TRANSIENT ((void(*)(void *))-1)
}
@SQLite3_BindParameterCount := GetProcAddress(DLLHandle, 'sqlite3_bind_parameter_count');
if not Assigned(@SQLite3_BindParameterCount) then Result := False;
@SQLite3_BindParameterName := GetProcAddress(DLLHandle, 'sqlite3_bind_parameter_name');
if not Assigned(@SQLite3_BindParameterName) then Result := False;
@SQLite3_BusyHandler := GetProcAddress(DLLHandle, 'sqlite3_busy_handler');
if not Assigned(@SQLite3_BusyHandler) then Result := False;
@SQLite3_BusyTimeout := GetProcAddress(DLLHandle, 'sqlite3_busy_timeout');
if not Assigned(@SQLite3_BusyTimeout) then Result := False;
@SQLite3_Changes := GetProcAddress(DLLHandle, 'sqlite3_changes');
if not Assigned(@SQLite3_Changes) then Result := False;
@SQLite3_Close := GetProcAddress(DLLHandle, 'sqlite3_close');
if not Assigned(@SQLite3_Close) then Result := False;
@SQlite_Collation_Needed := GetProcAddress(DLLHandle, 'sqlite3_collation_needed');
if not Assigned(@SQlite_Collation_Needed) then Result := False;
@SQlite_Collation_Needed16 := GetProcAddress(DLLHandle, 'sqlite3_collation_needed16');
if not Assigned(@SQlite_Collation_Needed16) then Result := False;
@SQLite3_Column_Blob := GetProcAddress(DLLHandle, 'sqlite3_column_blob');
if not Assigned(@SQLite3_Column_Blob) then Result := False;
@SQLite3_Column_Bytes := GetProcAddress(DLLHandle, 'sqlite3_column_bytes');
if not Assigned(@SQLite3_Column_Bytes) then Result := False;
@SQLite3_Column_Bytes16 := GetProcAddress(DLLHandle, 'sqlite3_column_bytes16');
if not Assigned(@SQLite3_Column_Bytes16) then Result := False;
@SQLite3_Column_Count := GetProcAddress(DLLHandle, 'sqlite3_column_count');
if not Assigned(@SQLite3_Column_Count) then Result := False;
@SQLite3_Column_Double := GetProcAddress(DLLHandle, 'sqlite3_column_double');
if not Assigned(@SQLite3_Column_Double) then Result := False;
@SQLite3_Column_Int := GetProcAddress(DLLHandle, 'sqlite3_column_int');
if not Assigned(@SQLite3_Column_Int) then Result := False;
@SQLite3_Column_Int64 := GetProcAddress(DLLHandle, 'sqlite3_column_int64');
if not Assigned(@SQLite3_Column_Int64) then Result := False;
@SQLite3_Column_Text := GetProcAddress(DLLHandle, 'sqlite3_column_text');
if not Assigned(@SQLite3_Column_Text) then Result := False;
@SQLite3_Column_Text16 := GetProcAddress(DLLHandle, 'sqlite3_column_text16');
if not Assigned(@SQLite3_Column_Text16) then Result := False;
@SQLite3_Column_Type := GetProcAddress(DLLHandle, 'sqlite3_column_type');
if not Assigned(@SQLite3_Column_Type) then Result := False;
@SQLite3_Column_Decltype := GetProcAddress(DLLHandle, 'sqlite3_column_decltype');
if not Assigned(@SQLite3_Column_Decltype) then Result := False;
@SQLite3_Column_Decltype16 := GetProcAddress(DLLHandle, 'sqlite3_column_decltype16');
if not Assigned(@SQLite3_Column_Decltype16) then Result := False;
@SQLite3_Column_Name := GetProcAddress(DLLHandle, 'sqlite3_column_name');
if not Assigned(@SQLite3_Column_Name) then Result := False;
@SQLite3_Column_Name16 := GetProcAddress(DLLHandle, 'sqlite3_column_name16');
if not Assigned(@SQLite3_Column_Name16) then Result := False;
{void *sqlite3_commit_hook(sqlite3*, int(*xCallback)(void*), void *pArg);}
@SQLite3_Complete := GetProcAddress(DLLHandle, 'sqlite3_complete');
if not Assigned(@SQLite3_Complete) then Result := False;
@SQLite3_Complete16 := GetProcAddress(DLLHandle, 'sqlite3_complete16');
if not Assigned(@SQLite3_Complete16) then Result := False;
@SQLite3_Create_Collation := GetProcAddress(DLLHandle, 'sqlite3_create_collation');
if not Assigned(@SQLite3_Create_Collation) then Result := False;
@SQLite3_Create_Collation16 := GetProcAddress(DLLHandle, 'sqlite3_create_collation16');
if not Assigned(@SQLite3_Create_Collation16) then Result := False;
{int sqlite3_create_function(
sqlite3 *,
const char *zFunctionName,
int nArg,
int eTextRep,
void*,
void (*xFunc)(sqlite3_context*,int,sqlite3_value**),
void (*xStep)(sqlite3_context*,int,sqlite3_value**),
void (*xFinal)(sqlite3_context*)
);}
{int sqlite3_create_function16(
sqlite3*,
const void *zFunctionName,
int nArg,
int eTextRep,
void*,
void (*xFunc)(sqlite3_context*,int,sqlite3_value**),
void (*xStep)(sqlite3_context*,int,sqlite3_value**),
void (*xFinal)(sqlite3_context*)
);}
@SQLite3_Data_Count := GetProcAddress(DLLHandle, 'sqlite3_data_count');
if not Assigned(@SQLite3_Data_Count) then Result := False;
@SQLite3_ErrCode := GetProcAddress(DLLHandle, 'sqlite3_errcode');
if not Assigned(@SQLite3_ErrCode) then Result := False;
@SQLite3_ErrorMsg := GetProcAddress(DLLHandle, 'sqlite3_errmsg');
if not Assigned(@SQLite3_ErrorMsg) then Result := False;
@SQLite3_ErrorMsg16 := GetProcAddress(DLLHandle, 'sqlite3_errmsg16');
if not Assigned(@SQLite3_ErrorMsg16) then Result := False;
@SQLite3_Exec := GetProcAddress(DLLHandle, 'sqlite3_exec');
if not Assigned(@SQLite3_Exec) then Result := False;
@SQLite3_Finalize := GetProcAddress(DLLHandle, 'sqlite3_finalize');
if not Assigned(@SQLite3_Finalize) then Result := False;
@SQLite3_Free := GetProcAddress(DLLHandle, 'sqlite3_free');
if not Assigned(@SQLite3_Free) then Result := False;
@SQLite3_GetTable := GetProcAddress(DLLHandle, 'sqlite3_get_table');
if not Assigned(@SQLite3_GetTable) then Result := False;
@SQLite3_FreeTable := GetProcAddress(DLLHandle, 'sqlite3_free_table');
if not Assigned(@SQLite3_FreeTable) then Result := False;
@SQLite3_Interrupt := GetProcAddress(DLLHandle, 'sqlite3_interrupt');
if not Assigned(@SQLite3_Interrupt) then Result := False;
@SQLite3_LastInsertRowId := GetProcAddress(DLLHandle, 'sqlite3_last_insert_rowid');
if not Assigned(@SQLite3_LastInsertRowId) then Result := False;
{char *sqlite3_mprintf(const char*,...);
char *sqlite3_vmprintf(const char*, va_list);
}
@SQLite3_Open := GetProcAddress(DLLHandle, 'sqlite3_open');
if not Assigned(@SQLite3_Open) then Result := False;
@SQLite3_Open16 := GetProcAddress(DLLHandle, 'sqlite3_open16');
if not Assigned(@SQLite3_Open16) then Result := False;
@SQLite3_Prepare := GetProcAddress(DLLHandle, 'sqlite3_prepare');
if not Assigned(@SQLite3_Prepare) then Result := False;
@SQLite3_Prepare16 := GetProcAddress(DLLHandle, 'sqlite3_prepare16');
if not Assigned(@SQLite3_Prepare16) then Result := False;
{void sqlite3_progress_handler(sqlite3*, int, int(*)(void*), void*);}
@SQLite3_Reset := GetProcAddress(DLLHandle, 'sqlite3_reset');
if not Assigned(@SQLite3_Reset) then Result := False;
{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*);
}
{int sqlite3_set_authorizer(
sqlite3*,
int (*xAuth)(void*,int,const char*,const char*,const char*,const char*),
void *pUserData
);
}
@SQLite3_Step := GetProcAddress(DLLHandle, 'sqlite3_step');
if not Assigned(@SQLite3_Step) then Result := False;
@SQLite3_Total_Changes := GetProcAddress(DLLHandle, 'sqlite3_total_changes');
if not Assigned(@SQLite3_Total_Changes) then Result := False;
@SQLite3_LibVersion := GetProcAddress(DLLHandle, 'sqlite3_libversion');
if not Assigned(@SQLite3_LibVersion) then Result := False;
{void *sqlite3_trace(sqlite3*, void(*xTrace)(void*,const char*), void*);
}
{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*);
}
//sqlite_progress_handler := GetProcAddress (DLLHandle, 'sqlite_progress_handler');
if not (Result) then
begin
{$IFDEF FPC}
UnloadLibrary(DLLHandle);
{$ELSE}
FreeLibrary(DLLHandle);
{$ENDIF}
DllHandle := 0;
//todo: nil all vars again...
end;
end;
Libs3Loaded := Result;
end;
initialization
//LibsLoaded := LoadLibs;
// MsgNoError := SystemErrorMsg(0);
finalization
if DLLHandle <> 0 then
try
{$IFDEF FPC}
UnloadLibrary(DLLHandle);
{$ELSE}
FreeLibrary(DLLHandle);
{$ENDIF}
finally
end;
end. PVOzerski » 09.10.2005 16:20:43
//Copyright © 2005 Pavel V. Ozerski
{$mode delphi}
{$smartlink off}
{$H+}
library sqlitudf;
uses
libsqlite3, sysutils;
const
NBFS = 32;
type
u8 = int64;
u16 = word;
CollSeq = record
zName: pChar; //* Name of the collating sequence, UTF-8 encoded */
enc: u8; //* Text encoding handled by xCmp() */
pUser: pointer; //* First argument to xCmp() */
xCmp: function(p1: pointer; p2: integer; const p3; p4: integer; const p5): integer; cdecl;
end;
t_destr = procedure(x: pointer); cdecl;
Mem = record
i: int64; //* Integer value */
n: integer; //* Number of characters in string value, including '\0' */
flags: u16; //* Some combination of MEM_Null, MEM_Str, MEM_Dyn, etc. */
_type: u8; //* One of MEM_Null, MEM_Str, etc. */
enc: u8; //* TEXT_Utf8, TEXT_Utf16le, or TEXT_Utf16be */
r: double; //* Real value */
z: pChar; //* String or BLOB value */
xDel: t_destr; //* If not null, call this function to delete Mem.z */
zShort: array[0..NBFS - 1] of char; //* Space for short strings */
end;
sqlite3_value = Mem;
p_sqlite3_value = ^sqlite3_value;
sqlite3_values = array[0..0] of p_sqlite3_value;
p_sqlite3_values = ^sqlite3_values;
p_sqlite3_context = ^sqlite3_context;
t_func = procedure(p1: p_sqlite3_context; p2: integer; var p3: p_sqlite3_value); cdecl;
t_final = procedure(p1: p_sqlite3_context); cdecl;
p_FuncDef = ^FuncDef;
FuncDef = record
zName: pChar; //* SQL name of the function */
nArg: integer; //* Number of arguments. -1 means unlimited */
iPrefEnc: u8; //* Preferred text encoding (SQLITE_UTF8, 16LE, 16BE) */
pUserData: pointer; //* User data parameter */
pNext: p_FuncDef; //* Next function with same name */
xFunc: t_func; //* Regular function */
xStep: t_func; //* Aggregate step */
xFinalize: t_final; //* Aggregate finializer */
needCollSeq: u8; //* True if sqlite3GetFuncCollSeq() might be called */
end;
AuxData = record
pAux: pointer; //* Aux data for the i-th argument */
xDelete: t_destr; //* Destructor for the aux data */
end;
VdbeFunc = record
pFunc: ^FuncDef; //* The definition of the function */
nAux: integer; //* Number of entries allocated for apAux[] */
apAux: array[0..0] of AuxData;
end;
sqlite3_context = record
pFunc: ^FuncDef; //* Pointer to function information. MUST BE FIRST */
pVdbeFunc: ^VdbeFunc; //* Auxilary data, if created. */
s: Mem; //* The return value is stored here */
pAgg: pointer; //* Aggregate context */
isError: u8 ; //* Set to true for an error */
cnt: integer; //* Number of times that the step function has been called */
pColl: ^CollSeq;
end;
function sqlite3_value_type(var p1: sqlite3_value): integer; cdecl;
external 'sqlite3.dll';
function sqlite3_value_text(var p: sqlite3_value): pchar; cdecl;
external 'sqlite3.dll';
procedure sqlite3_result_text(var p1: sqlite3_context; p2: pchar; p3: integer; p4: pointer); cdecl;
external 'sqlite3.dll';
function sqlite3_value_int64(var p: sqlite3_value): int64; cdecl;
external 'sqlite3.dll';
procedure sqlite3_result_int64(var context: sqlite3_context; p: int64); cdecl;
external 'sqlite3.dll';
procedure sqlite3_result_null(var p: sqlite3_context); cdecl;
external 'sqlite3.dll';
function sqlite3_value_double(var p: sqlite3_value): double; cdecl;
external 'sqlite3.dll';
procedure sqlite3_result_double(var p1: sqlite3_context; p2: double); cdecl;
external 'sqlite3.dll';
procedure commonpartofsets(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
i: integer;
rVal: double;
rset, rsubset: set of byte;
begin
rset := [];
rsubset := [];
for i := 0 to pred(argc) do
if sqlite3_value_type(argv[i]^) = SQLITE_FLOAT then
begin
rVal := sqlite3_value_double(argv[i]^);
if i = 0 then
move(rVal, rset, sizeof(double))
else
begin
move(rVal, rsubset, sizeof(double));
rset := rset * rsubset;
end;
end;
move(rset, rVal, sizeof(rVal));
sqlite3_result_double(context, rVal);
end;
procedure unitesets(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
i: integer;
rVal: double;
rset, rsubset: set of byte;
begin
rset:=[];
rsubset:=[];
for i := 0 to pred(argc) do
if sqlite3_value_type(argv[i]^) = SQLITE_FLOAT then
begin
rVal := sqlite3_value_double(argv[i]^);
move(rVal, rsubset, sizeof(double));
rset:=rset+rsubset;
end;
move(rset, rVal, sizeof(rVal));
sqlite3_result_double(context, rVal);
end;
procedure excludefromset(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
i: integer;
iVal: int64;
rVal: double;
rset, rsubset: set of byte;
begin
rset := [];
if (argc > 0) and (sqlite3_value_type(argv[0]^) = SQLITE_FLOAT) then
begin
rVal := sqlite3_value_double(argv[0]^);
move(rVal, rset, sizeof(double));
end;
for i := 1 to pred(argc) do
if sqlite3_value_type(argv[i]^) = SQLITE_INTEGER then
begin
iVal := sqlite3_value_int64(argv[i]^);
exclude(rset, byte(iVal));
end;
move(rset, rVal, sizeof(rVal));
sqlite3_result_double(context, rVal);
end;
procedure includetoset(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
i: integer;
iVal: int64;
rVal: double;
rset, rsubset: set of byte;
begin
rset := [];
if (argc > 0) and (sqlite3_value_type(argv[0]^) = SQLITE_FLOAT) then
begin
rVal := sqlite3_value_double(argv[0]^);
move(rVal, rset, sizeof(double));
end;
for i := 1 to pred(argc) do
if sqlite3_value_type(argv[i]^) = SQLITE_INTEGER then
begin
iVal := sqlite3_value_int64(argv[i]^);
include(rset, byte(iVal));
end;
move(rset, rVal, sizeof(rVal));
sqlite3_result_double(context, rVal);
end;
procedure displayset(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
i: integer;
rVal: double;
rset, rsubset: set of byte;
const
s: shortstring = '';
var
ss: shortstring;
begin
s := '';
if (argc = 1) and (sqlite3_value_type(argv[0]^) = SQLITE_FLOAT) then
begin
rVal := sqlite3_value_double(argv[0]^);
move(rVal, rset, sizeof(double));
for i := 0 to 63 do
if byte(i) in rset then
begin
str(i:0, ss);
if s <> '' then
s := s + ' ';
s := s + ss;
end;
end;
s := s + #0;
sqlite3_result_text(context, @s[1], -1, nil);
//writeln('done ' ,s);
end;
procedure containsassubset(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
iVal: int64;
rVal: double;
rset, rsubset: set of byte;
begin
iVal := 0;
if argc = 2 then
if (sqlite3_value_type(argv[0]^) = SQLITE_FLOAT) and (sqlite3_value_type(argv[1]^) = SQLITE_FLOAT) then
begin
rset := [];
rsubset:=[];
rVal := sqlite3_value_double(argv[0]^);
move(rVal, rset, sizeof(double));
rVal := sqlite3_value_double(argv[1]^);
move(rVal, rsubset, sizeof(double));
if rsubset * rset = rsubset then
iVal := -1;
end;
sqlite3_result_int64(context, iVal);
end;
procedure hasinside(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
iVal: int64;
rVal: double;
rset: set of byte;
begin
iVal := 0;
if argc = 2 then
if (sqlite3_value_type(argv[0]^) = SQLITE_FLOAT) and (sqlite3_value_type(argv[1]^) = SQLITE_INTEGER) then
begin
rset:=[];
rVal := sqlite3_value_double(argv[0]^);
move(rVal, rset, sizeof(double));
if byte(sqlite3_value_int64(argv[1]^))in rset then
iVal := -1;
end;
sqlite3_result_int64(context, iVal);
end;
procedure packasset(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
rset: set of byte;
i: integer;
rVal: double;
begin
rset:=[];
for i := 0 to pred(argc) do
if sqlite3_value_type(argv[i]^) = SQLITE_INTEGER then
include(rset, byte(sqlite3_value_int64(argv[i]^)));
move(rset, rVal, sizeof(double));
sqlite3_result_double(context, rVal);
end;
procedure setisempty(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
rset: set of byte;
iVal: int64;
rVal: double;
begin
iVal := 0;
if argc = 1 then
if sqlite3_value_type(argv[0]^) = SQLITE_FLOAT then
begin
rset:=[];
rVal := sqlite3_value_double(argv[0]^);
move(rVal, rset, sizeof(double));
if rset=[] then
iVal := -1;
end;
sqlite3_result_int64(context, iVal);
end;
const
Labv: string[33]='рстуфхцчшщъыьэюяЁёЄєЇїЎў°?·?№¤? ?';
Uabv: string[33]='????????????????????????????????и';
function standardize(s: pchar; l: cardinal): string;
var
i, j: cardinal;
begin
SetLength(Result, l);
if l <= 0 then
exit;
move(s^, Result[1], l);
for i := 1 to l do
if Result[i] in ['a'..'z'] then
Result[i] := upcase(Result[i])
else if Result[i] in ['и', '?']then
Result[i]:='?'
else
for j := 1 to length(Labv) do
if Result[i] = Labv[j] then
begin
Result[i] := Uabv[j];
break;
end;
end;
function GetLen(p: pchar): integer;
begin
if assigned(p) then
Result := StrLen(p)
else
Result := 0;
end;
procedure equal1251(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
last: cardinal;
b: boolean;
c1, c2: char;
ss1, ss2: String;
iVal: int64;
cVal1, cVal2: pchar;
l1, l2 : integer;
begin
b := false;
iVal := 0;
if argc > 1 then
if (sqlite3_value_type(argv[0]^) = SQLITE_TEXT) and (sqlite3_value_type(argv[1]^) = SQLITE_TEXT) then
begin
cVal1 := sqlite3_value_text(argv[0]^);
cVal2 := sqlite3_value_text(argv[1]^);
l1 := GetLen(cVal1);
l2 := GetLen(cVal2);
if l1 = l2 then
begin
if l1 = 0 then
b := true
else
begin
ss1 := standardize(cVal1, l1);
ss2 := standardize(cVal2, l2);
b := ss1 = ss2;
end;
end;
end;
if b then
iVal := -1;
sqlite3_result_int64(context, iVal);
end;
procedure issubstr1251(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
i, last: cardinal;
c1, c2: char;
ss1, ss2: string;
iVal: int64;
cVal1, cVal2: pchar;
l1, l2: integer;
begin
iVal := 0;
if argc > 1 then
if (sqlite3_value_type(argv[0]^) = SQLITE_TEXT) and (sqlite3_value_type(argv[1]^) = SQLITE_TEXT) then
begin
cVal1 := sqlite3_value_text(argv[0]^);
cVal2 := sqlite3_value_text(argv[1]^);
l1 := GetLen(cVal1);
l2 := GetLen(cVal2);
if l1 <= l2 then
begin
if l1 = 0 then
iVal := -1
else
begin
ss1 := standardize(cVal1, l1);
ss2 := standardize(cVal2, l2);
iVal := Pos(ss1, ss2);
if iVal <> 0 then
iVal := -1;
end;
end;
end;
sqlite3_result_int64(context, iVal);
end;
type
tdata = record
name: ansistring;
sdata: ansistring;
case datatype: integer of
SQLITE_INTEGER:(idata: int64);
SQLITE_FLOAT:(fdata: double);
end;
var
vartable: array[0..255] of tdata;
procedure setvar(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
var
iVal: int64;
rVal: double;
dt: integer;
varIndex: integer;
function NewVar: boolean;
var
i: integer;
nVal: pchar;
begin
nVal := sqlite3_value_text(argv[0]^);
for i := 0 to 255 do
if (strcomp(pchar(vartable[i].name), nVal) = 0) or (vartable[i].name = '') then
begin
varIndex := i;
break;
end;
Result := varIndex <> -1;
if Result then
begin
vartable[varIndex].name := ansistring(nVal);
vartable[varIndex].datatype := dt;
iVal := -1;
end;
end;
begin
varIndex:= -1;
iVal := 0;
if (argc = 2) and (sqlite3_value_type(argv[0]^) = SQLITE_TEXT) then
begin
dt := sqlite3_value_type(argv[1]^);
case dt of
SQLITE_TEXT:
begin
if NewVar then
vartable[varIndex].sdata := AnsiString(sqlite3_value_text(argv[1]^));
end;
SQLITE_FLOAT:
begin
if NewVar then
vartable[varIndex].fdata := sqlite3_value_double(argv[1]^);
end;
SQLITE_INTEGER:
begin
if NewVar then
vartable[varIndex].idata := sqlite3_value_int64(argv[1]^);
end;
end;
end;
sqlite3_result_int64(context, iVal);
end;
procedure getvar(var context: sqlite3_context; argc: integer; argv: p_sqlite3_values); cdecl; export;
const
nodata: char = #0;
var
i: integer;
nVal, cVal: pchar;
iVal: int64;
rVal: double;
begin
cVal := @nodata;
if (argc = 1) and (sqlite3_value_type(argv[0]^) = SQLITE_TEXT) then
begin
nVal := sqlite3_value_text(argv[0]^);
for i := 0 to 255 do
if StrComp(nVal, pchar(vartable[i].name)) = 0 then
case vartable[i].datatype of
SQLITE_TEXT:
begin
cVal := pChar(vartable[i].sdata);
break;
end;
SQLITE_FLOAT:
begin
sqlite3_result_double(context, vartable[i].fdata);
exit;
end;
SQLITE_INTEGER:
begin
sqlite3_result_int64(context, vartable[i].idata);
exit;
end;
end;
end;
sqlite3_result_text(context, cVal, -1, nil);
end;
exports
commonpartofsets name 'commonpartofsets',
unitesets name 'unitesets',
excludefromset name 'excludefromset',
includetoset name 'includetoset',
displayset name 'displayset',
containsassubset name 'containsassubset',
hasinside name 'hasinside',
packasset name 'packasset',
setisempty name 'setisempty',
equal1251 name 'equal1251',
issubstr1251 name 'issubstr1251',
getvar name 'getvar',
setvar name 'setvar';
begin
end. PVOzerski » 09.10.2005 16:28:04
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)
Minimal changes by Pavel V. Ozerski (http://sounds.evol.nw.ru)
}
interface
uses
Windows, SQLite3, Classes, Sysutils;
const
dtStr = 0;
dtInt = 1;
dtBool = 2;
dtNumeric = 3;
dtBlob = 4;
type
pboolean =^boolean;
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;
property DB: TSQLiteDB read fDB; //PVO
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;
function GetColTypes(I: integer): Integer; //PVO;
public
constructor Create(DB: TSQLiteDatabase; const SQL: string);
destructor Destroy; override;
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;
property ColTypes[I: Integer]: integer read GetColTypes; //PVO
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;');
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
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;
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);
if pInteger(self.fColTypes[iColNo])^ = dtBlob then
begin TMemoryStream(fResults[i]).free end
else
begin dispose(fResults[i]) end;
end end;
fResults.Free;
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;
var
iCount: integer;
sColName: string;
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
//look for a match with the dot
for iCount := 0 to fCols.Count - 1 do
begin
sColName := fCols[iCount];
if uppercase(AnsiRightstr(sColName, length(FieldName) + 1)) = '.' + uppercase(fieldname) then
begin
if result < 0 then
begin result := iCount end
else
begin raise ESqliteException.Create('Specify table as well as column name: ' + fieldname) end;
end;
end;
end;
if (result < 0) then
begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end;
end;
//..............................................................................
function TSQLiteTable.GetColTypes(I: Integer): Integer; //PVO
begin
if I >= fColTypes.Count then
begin
Result := -1;
raise ESqliteException.Create('Invalid Field Number');
end
else
Result := pInteger(self.fColTypes[I])^;
end;
function TSQLiteTable.GetFields(I: Integer): string;
var
thisvalue: pstring;
ptr: pointer;
thisblobvalue: TMemoryStream;
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(I: Integer): TMemoryStream;
var
ptrvalue: pchar;
begin
if EOF then
begin raise ESqliteException.Create('Table is at End of File') end;
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(I: integer): string;
var
MemStream: TMemoryStream;
Buffer: PChar;
begin
result := '';
MemStream := self.FieldAsBlob(I);
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(I: integer): integer;
begin
if EOF then
begin raise ESqliteException.Create('Table is at End of File') end;
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(I: integer): double;
begin
if EOF then
begin raise ESqliteException.Create('Table is at End of File') end;
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(I: integer): boolean;
begin
if EOF then
begin raise ESqliteException.Create('Table is at End of File') end;
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(I: Integer): string;
begin
if EOF then
begin raise ESqliteException.Create('Table is at End of File') end;
if (self.fResults[(self.frow * self.fColCount) + I] = nil) then
begin result := '' end
else
begin result := self.GetFields(I) end;
end;
function TSqliteTable.FieldIsNull(I: integer): boolean;
var
thisvalue: pointer;
begin
if EOF then
begin raise ESqliteException.Create('Table is at End of File') end;
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. Stargazer » 11.10.2005 02:07:36
Ururu » 28.06.2008 10:09:59
TSQLiteDatabase = class
private
fDB: TSQLiteDB;
fInTrans: Boolean;
procedure RaiseError(s: string; SQL: string);
function callrez(notused:Pointer; coln:Integer;rows,colname:PUChar ):Integer;
var
pc,pc1:Pchar;
s: string;
begin
pc:=rows^;
Form1.Memo1.Lines.Add(pc);
Form1.Memo1.Lines.Add('rerr');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
{sql: array of PChar=('CREATE TABLE [company] ([cm_id] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,[cm_name] NVARCHAR(30) NULL)' ,
'CREATE TABLE [person] ([pr_id] INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,[pr_first_name] VARCHAR(30) NOT NULL,[pr_last_name] VARCHAR(30) NOT NULL,[pr_age] INTEGER NULL,[pr_company_id] INTEGER NULL )');
}rc,i:Integer;
errmsg:Pchar;
begin
i:=sqlite3_open('Base.db',PDataBase);
rc:= sqlite3_exec(PdataBase, 'CREATE TABLE [company] ([cm_id] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,[cm_name] NVARCHAR(30) NULL)', @callrez, NIL, errmsg);
rc:=sqlite3_exec(PdataBase,'INSERT INTO company VALUES (NULL, ''Company_1'')',@callrez, NIL, errmsg);
rc:=sqlite3_exec(PdataBase,'INSERT INTO company VALUES (NULL, ''Company_2'')',@callrez, NIL, errmsg);
rc:=sqlite3_exec(PdataBase,'SELECT * FROM company WHERE cm_id=2',@callrez, NIL, errmsg);
sqlite3_close(PDataBase);
ShowMessage(errmsg);
end;
Attid » 28.06.2008 11:44:32
debi12345 » 28.06.2008 12:25:22
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10