mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 19:09:16 +02:00
+ Contributed sqlite3db by Gilles Marcou - g.marcou@chimie.u-strasbg.fr
git-svn-id: trunk@6606 -
This commit is contained in:
daniel
parent
06208b5c5d
commit
d41b68dd93
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2046,6 +2046,7 @@ packages/base/sqlite/fpmake.inc svneol=native#text/plain
|
||||
packages/base/sqlite/fpmake.pp svneol=native#text/plain
|
||||
packages/base/sqlite/sqlite.pp svneol=native#text/plain
|
||||
packages/base/sqlite/sqlite3.pp svneol=native#text/plain
|
||||
packages/base/sqlite/sqlite3db.pas svneol=native#text/x-pascal
|
||||
packages/base/sqlite/sqlitedb.pas svneol=native#text/plain
|
||||
packages/base/sqlite/test.pas svneol=native#text/plain
|
||||
packages/base/sqlite/testapiv3x.README -text
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/01/25]
|
||||
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/12/01]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-embedded
|
||||
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince arm-gba powerpc64-linux
|
||||
BSDs = freebsd netbsd openbsd darwin
|
||||
UNIXs = linux $(BSDs) solaris qnx
|
||||
LIMIT83fs = go32v2 os2 emx watcom
|
||||
@ -233,157 +233,127 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/ext
|
||||
override PACKAGE_NAME=sqlite
|
||||
override PACKAGE_VERSION=2.0.0
|
||||
ifeq ($(FULL_TARGET),i386-linux)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-go32v2)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-win32)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-os2)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-freebsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-beos)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netbsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-solaris)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-qnx)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netware)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-openbsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-wdosx)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-darwin)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-emx)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-watcom)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netwlibc)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-wince)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-embedded)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-symbian)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-linux)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-freebsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-netbsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-amiga)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-atari)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-openbsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-palmos)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-embedded)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-linux)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-netbsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-amiga)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-macos)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-darwin)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-morphos)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-embedded)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-linux)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-netbsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-solaris)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-embedded)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-linux)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-freebsd)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-win64)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-embedded)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-linux)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-palmos)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-wince)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-gba)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-nds)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-embedded)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-symbian)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc64-linux)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc64-embedded)
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb
|
||||
override TARGET_UNITS+=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
endif
|
||||
override INSTALL_FPCPACKAGE=y
|
||||
override SHARED_BUILD=n
|
||||
@ -714,10 +684,6 @@ EXEEXT=.gba
|
||||
SHAREDLIBEXT=.so
|
||||
SHORTSUFFIX=gba
|
||||
endif
|
||||
ifeq ($(OS_TARGET),symbian)
|
||||
SHAREDLIBEXT=.dll
|
||||
SHORTSUFFIX=symbian
|
||||
endif
|
||||
else
|
||||
ifeq ($(OS_TARGET),go32v1)
|
||||
PPUEXT=.pp1
|
||||
@ -1187,12 +1153,6 @@ endif
|
||||
ifeq ($(FULL_TARGET),i386-wince)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-embedded)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-symbian)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-linux)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
@ -1214,9 +1174,6 @@ endif
|
||||
ifeq ($(FULL_TARGET),m68k-palmos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-embedded)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-linux)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
@ -1235,9 +1192,6 @@ endif
|
||||
ifeq ($(FULL_TARGET),powerpc-morphos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-embedded)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-linux)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
@ -1247,9 +1201,6 @@ endif
|
||||
ifeq ($(FULL_TARGET),sparc-solaris)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-embedded)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-linux)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
@ -1259,9 +1210,6 @@ endif
|
||||
ifeq ($(FULL_TARGET),x86_64-win64)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-embedded)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-linux)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
@ -1274,21 +1222,9 @@ endif
|
||||
ifeq ($(FULL_TARGET),arm-gba)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-nds)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-embedded)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-symbian)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc64-linux)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc64-embedded)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
endif
|
||||
ifdef REQUIRE_PACKAGES_RTL
|
||||
PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
|
||||
ifneq ($(PACKAGEDIR_RTL),)
|
||||
@ -1366,7 +1302,7 @@ ifeq ($(CPU_TARGET),powerpc)
|
||||
FPCCPUOPT:=-O1r
|
||||
endif
|
||||
else
|
||||
FPCCPUOPT:=-O2
|
||||
FPCCPUOPT:=-O1r
|
||||
endif
|
||||
override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
|
||||
override FPCOPTDEF+=RELEASE
|
||||
@ -1425,13 +1361,6 @@ ifeq ($(CPU_TARGET),i386)
|
||||
override FPCOPT+=-Aas
|
||||
endif
|
||||
endif
|
||||
ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
ifeq ($(CPU_TARGET),x86_64)
|
||||
override FPCOPT+=-Cg
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
ifdef LINKSHARED
|
||||
endif
|
||||
ifdef OPT
|
||||
|
||||
@ -7,7 +7,7 @@ name=sqlite
|
||||
version=2.0.0
|
||||
|
||||
[target]
|
||||
units=sqlite sqlite3 sqlitedb
|
||||
units=sqlite sqlite3 sqlitedb sqlitedb3
|
||||
|
||||
[require]
|
||||
|
||||
|
||||
494
packages/base/sqlite/sqlite3db.pas
Normal file
494
packages/base/sqlite/sqlite3db.pas
Normal file
@ -0,0 +1,494 @@
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
{*************************************************************
|
||||
SQLite3 Object Oriented handle
|
||||
O. Rinaudo - 2005 - orinaudo@gmail.com
|
||||
G. Marcou - 2007 - g.marcou@chimie.u-strasbg.fr
|
||||
*************************************************************}
|
||||
|
||||
unit SQLite3db;
|
||||
|
||||
interface
|
||||
|
||||
uses Classes,strings,sqlite3;
|
||||
{*************************************************************}
|
||||
{*************************************************************}
|
||||
type
|
||||
TSQLiteExecCallback = function(Sender: pointer; Columns: Integer; ColumnValues: ppchar; ColumnNames: ppchar): integer of object; cdecl;
|
||||
TSQLiteBusyCallback = function(Sender: TObject; BusyCount: integer): longint of object; cdecl;
|
||||
TOnData = Procedure(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String) of object;
|
||||
TOnBusy = Procedure(Sender: TObject; BusyCount: integer; var Cancel: Boolean) of object;
|
||||
TOnQueryComplete = Procedure(Sender: TObject) of object;
|
||||
|
||||
TSQLite = class(TObject)
|
||||
{*************************************************************}
|
||||
{*************************************************************}
|
||||
private
|
||||
fPSQlite: PPsqlite3;
|
||||
fSQLite:Psqlite3;
|
||||
fMsg: String;
|
||||
fIsOpen: Boolean;
|
||||
fBusy: Boolean;
|
||||
fError: longint;
|
||||
fVersion: String;
|
||||
fEncoding: String;
|
||||
fTable: TStrings;
|
||||
fLstName: TStringList;
|
||||
fLstVal: TStringList;
|
||||
fOnData: TOnData;
|
||||
fOnBusy: TOnBusy;
|
||||
fOnQueryComplete: TOnQueryComplete;
|
||||
fBusyTimeout: longint;
|
||||
fPMsg: PChar;
|
||||
fChangeCount: longint;
|
||||
fNb_Champ : Integer;
|
||||
fList_FieldName : TStringList;
|
||||
fList_Field : TList;
|
||||
procedure SetBusyTimeout(Timeout: integer);
|
||||
{*************************************************************}
|
||||
{*************************************************************}
|
||||
public
|
||||
constructor Create(DBFileName: String);
|
||||
destructor Destroy; override;
|
||||
function Query(Sql: String; Table: TStrings ): boolean;
|
||||
function ErrorMessage(ErrNo: Integer): string;
|
||||
function IsComplete(Sql: String): boolean;
|
||||
function LastInsertRow: integer;
|
||||
function Cancel: boolean;
|
||||
function DatabaseDetails(Table: TStrings): boolean;
|
||||
property LastErrorMessage: string read fMsg;
|
||||
property LastError: longint read fError;
|
||||
property Version: String read fVersion;
|
||||
property Encoding: String read fEncoding;
|
||||
property OnData: TOnData read fOnData write fOnData;
|
||||
property OnBusy: TOnBusy read fOnBusy write fOnBusy;
|
||||
property OnQueryComplete: TOnQueryComplete read fOnQueryComplete write fOnQueryComplete;
|
||||
property BusyTimeout: longint read fBusyTimeout write SetBusyTimeout;
|
||||
property ChangeCount: longint read fChangeCount;
|
||||
property List_FieldName: TStringList read fList_FieldName write fList_FieldName;
|
||||
property List_Field: TList read fList_Field write fList_Field;
|
||||
property Nb_Champ: integer read fNb_Champ write fNb_Champ;
|
||||
procedure SQLOnData(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String);
|
||||
|
||||
end;
|
||||
function Pas2SQLStr(const PasString: string): string;
|
||||
function SQL2PasStr(const SQLString: string): string;
|
||||
function QuoteStr(const s: string; QuoteChar: Char ): string;
|
||||
function UnQuoteStr(const s: string; QuoteChar: Char ): string;
|
||||
procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
|
||||
{*************************************************************}
|
||||
{*************************************************************}
|
||||
implementation
|
||||
Const
|
||||
DblQuote: Char = '"';
|
||||
SngQuote: Char = #39;
|
||||
DblSngQuote: String = #39#39;
|
||||
Crlf: String = #13#10;
|
||||
Tab: Char = #9;
|
||||
var
|
||||
MsgNoError : String;
|
||||
{*************************************************************}
|
||||
{*************************************************************}
|
||||
function QuoteStr(const s: string; QuoteChar: Char ): string;
|
||||
{*************************************************************
|
||||
SQlite3 enclosing string with quotes
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
Result := Concat(QuoteChar, s, QuoteChar);
|
||||
end;
|
||||
{*************************************************************}
|
||||
function UnQuoteStr(const s: string; QuoteChar: Char ): string;
|
||||
{*************************************************************
|
||||
SQlite3 Remove enclosing quotes from string
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
Result := s;
|
||||
if length(Result) > 1 then
|
||||
begin
|
||||
if Result[1] = QuoteChar then
|
||||
Delete(Result, 1, 1);
|
||||
if Result[Length(Result)] = QuoteChar then
|
||||
Delete(Result, Length(Result), 1);
|
||||
end;
|
||||
end;
|
||||
{*************************************************************}
|
||||
function Pas2SQLStr(const PasString: string): string;
|
||||
{*************************************************************
|
||||
SQlite3 SQL string are use double quotes, Pascal string use
|
||||
single quote.
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
var
|
||||
n : integer;
|
||||
begin
|
||||
Result := SQL2PasStr(PasString);
|
||||
n := Length(Result);
|
||||
while n > 0 do
|
||||
begin
|
||||
if Result[n] = SngQuote then
|
||||
Insert(SngQuote, Result, n);
|
||||
dec(n);
|
||||
end;
|
||||
Result := QuoteStr(Result,SngQuote);
|
||||
end;
|
||||
{*************************************************************}
|
||||
function SQL2PasStr(const SQLString: string): string;
|
||||
{*************************************************************
|
||||
SQlite3 SQL string are use double quotes, Pascal string use
|
||||
single quote.
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
var
|
||||
p : integer;
|
||||
begin
|
||||
Result := SQLString;
|
||||
p := pos(DblSngQuote, Result);
|
||||
while p > 0 do
|
||||
begin
|
||||
Delete(Result, p, 1);
|
||||
p := pos(DblSngQuote, Result);
|
||||
end;
|
||||
Result := UnQuoteStr(Result,SngQuote);
|
||||
end;
|
||||
{*************************************************************}
|
||||
procedure ValueList(const ColumnNames, ColumnValues : String;
|
||||
NameValuePairs : TStrings);
|
||||
{*************************************************************
|
||||
SQlite3 build (name=value) pair list
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
var
|
||||
n : integer;
|
||||
lstName, lstValue : TStringList;
|
||||
begin
|
||||
if NameValuePairs <> nil then
|
||||
begin
|
||||
lstName := TStringList.Create;
|
||||
lstValue := TStringList.Create;
|
||||
lstName.CommaText := ColumnNames;
|
||||
lstValue.CommaText := ColumnValues;
|
||||
NameValuePairs.Clear;
|
||||
if lstName.Count = LstValue.Count then
|
||||
if lstName.Count > 0 then
|
||||
for n := 0 to lstName.Count - 1 do
|
||||
NameValuePairs.Append(Concat(lstName.Strings[n], '=', lstValue.Strings[n]));
|
||||
lstValue.Free;
|
||||
lstName.Free;
|
||||
end;
|
||||
end;
|
||||
{*************************************************************}
|
||||
{function SystemErrorMsg(ErrNo: Integer ): String;
|
||||
var
|
||||
buf: PChar;
|
||||
size: Integer;
|
||||
MsgLen: Integer;
|
||||
begin}
|
||||
{ size := 256;
|
||||
GetMem(buf, size);
|
||||
If ErrNo = - 1 then
|
||||
ErrNo := GetLastError;
|
||||
MsgLen := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrNo, 0, buf, size, nil);
|
||||
if MsgLen = 0 then
|
||||
Result := 'ERROR'
|
||||
else
|
||||
Result := buf;}
|
||||
{end;}
|
||||
{*************************************************************}
|
||||
function BusyCallback(Sender : pointer;
|
||||
BusyCount : integer): longint; cdecl;
|
||||
{*************************************************************
|
||||
SQlite3 busy callback
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
var
|
||||
bCancel: Boolean;
|
||||
begin
|
||||
Result := -1;
|
||||
with TObject(Sender) as TSQLite do
|
||||
begin
|
||||
if Assigned(fOnBusy) then
|
||||
begin
|
||||
bCancel := False;
|
||||
fOnBusy(Tobject(Sender), BusyCount, bCancel);
|
||||
if bCancel then
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{*************************************************************}
|
||||
function ExecCallback(Sender : Pointer;
|
||||
Columns : Integer;
|
||||
ColumnValues : PPChar;
|
||||
ColumnNames : PPchar): integer; cdecl;
|
||||
{*************************************************************
|
||||
SQlite3 Build table and data from callback
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
var
|
||||
PVal, PName : ^PChar;
|
||||
n : integer;
|
||||
sVal, sName : String;
|
||||
begin
|
||||
Result := 0;
|
||||
with TObject(Sender) as TSQLite do
|
||||
begin
|
||||
if (Assigned(fOnData) or Assigned(fTable)) then
|
||||
begin
|
||||
fLstName.Clear;
|
||||
fLstVal.Clear;
|
||||
if Columns > 0 then
|
||||
begin
|
||||
PName := ColumnNames;
|
||||
PVal := ColumnValues;
|
||||
for n := 0 to Columns - 1 do
|
||||
begin
|
||||
fLstName.Append(PName^);
|
||||
fLstVal.Append(PVal^);
|
||||
inc(PName);
|
||||
inc(PVal);
|
||||
end;
|
||||
end;
|
||||
sVal := fLstVal.CommaText;
|
||||
sName := fLstName.CommaText;
|
||||
if Assigned(fOnData) then
|
||||
fOnData(TObject(Sender), Columns, sName, sVal);
|
||||
if Assigned(fTable) then
|
||||
begin
|
||||
if fTable.Count = 0 then
|
||||
fTable.Append(sName);
|
||||
fTable.Append(sVal);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{*************************************************************}
|
||||
procedure TSQLite.SQLOnData(Sender : TObject;
|
||||
Columns : Integer;
|
||||
ColumnNames, ColumnValues : String);
|
||||
{*************************************************************
|
||||
SQlite3 Fill up field list names and field list values
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
Var
|
||||
InterS,val : String;
|
||||
Field : TStringList;
|
||||
{************************************************}
|
||||
function Pos1(a: String ; s : char) : integer;
|
||||
var i,j : Integer;
|
||||
begin
|
||||
j:=-1;
|
||||
for i:=1 to length(a) Do
|
||||
begin
|
||||
if a[i] = s then
|
||||
begin
|
||||
j:=i;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
result:=j;
|
||||
end; { Pos1 }
|
||||
{*************************************************}
|
||||
begin
|
||||
If Nb_Champ = -1 Then
|
||||
Begin {Put the fields name in List_FieldName}
|
||||
Nb_Champ:=Columns;
|
||||
InterS:=ColumnNames;
|
||||
While (Pos1(InterS,',') > 0) do
|
||||
begin
|
||||
val:=copy(InterS,1,Pos1(InterS,',')-1);
|
||||
InterS:=copy(InterS,Pos1(InterS,',')+1,length(InterS));
|
||||
List_FieldName.add(val);
|
||||
end;
|
||||
if length(InterS) > 0 then List_FieldName.add(InterS);
|
||||
end;
|
||||
{Put the list of TStringList of value}
|
||||
Field :=TStringList.Create;
|
||||
InterS:=ColumnValues;
|
||||
While (Pos1(InterS,',') > 0) do
|
||||
begin
|
||||
val:=copy(InterS,1,Pos1(InterS,',')-1);
|
||||
InterS:=copy(InterS,Pos1(InterS,',')+1,length(InterS));
|
||||
Field.add(val);
|
||||
end;
|
||||
if length(InterS) > 0 then Field.add(InterS);
|
||||
List_Field.add(Field);
|
||||
end;
|
||||
{*************************************************************}
|
||||
constructor TSQLite.Create(DBFileName: String);
|
||||
{*************************************************************
|
||||
SQlite3 constructor
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
var
|
||||
name : pchar;
|
||||
begin
|
||||
inherited Create;
|
||||
List_FieldName := TStringList.Create;
|
||||
List_Field := TList.Create;
|
||||
fError := SQLITE_ERROR;
|
||||
fIsOpen := False;
|
||||
fLstName := TStringList.Create;
|
||||
fLstVal := TStringList.Create;
|
||||
fOnData := nil;
|
||||
fOnBusy := nil;
|
||||
fOnQueryComplete := nil;
|
||||
fChangeCount := 0;
|
||||
name:=StrAlloc (length(DBFileName)+1);
|
||||
strpcopy(name,DBFileName);
|
||||
OnData:=@SQLOnData;
|
||||
writeln('Try to open');
|
||||
sqlite3_open(name,@fSQLite);
|
||||
writeln('Open success');
|
||||
sqlite3_free(fPMsg);
|
||||
writeln('Free memory');
|
||||
if fSQLite <> nil then
|
||||
begin
|
||||
//fVersion := String(SQLite_Version);
|
||||
//fEncoding := SQLite_Encoding;
|
||||
fIsOpen := True;
|
||||
fError := SQLITE_OK;
|
||||
end;
|
||||
fMsg := sqlite3_errmsg(fSQLite);
|
||||
end;
|
||||
{*************************************************************}
|
||||
destructor TSQLite.Destroy;
|
||||
{*************************************************************
|
||||
SQLite3 destructor
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
if fIsOpen then
|
||||
fError:=sqlite3_close(fSQLite);
|
||||
fIsOpen := False;
|
||||
fLstName.Free;
|
||||
fLstVal.Free;
|
||||
fSQLite := nil;
|
||||
fOnData := nil;
|
||||
fOnBusy := nil;
|
||||
fOnQueryComplete := nil;
|
||||
fLstName := nil;
|
||||
fLstVal := nil;
|
||||
List_FieldName.destroy;
|
||||
List_Field.destroy;
|
||||
inherited Destroy;
|
||||
end;
|
||||
{*************************************************************}
|
||||
function TSQLite.Query(Sql: String; Table: TStrings ): boolean;
|
||||
{*************************************************************
|
||||
SQLite3 query the database
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
//var
|
||||
// fPMsg: PChar;
|
||||
//var Psql : pchar;
|
||||
begin
|
||||
fError := SQLITE_ERROR;
|
||||
if fIsOpen then
|
||||
begin
|
||||
fPMsg := nil;
|
||||
fBusy := True;
|
||||
fTable := Table;
|
||||
if fTable <> nil then
|
||||
fTable.Clear;
|
||||
List_FieldName.clear;
|
||||
List_Field.clear;
|
||||
Nb_Champ:=-1;
|
||||
fError := sqlite3_exec(fSQLite, PChar(sql), @ExecCallback, Self, @fPMsg);
|
||||
sqlite3_free(fPMsg);
|
||||
fChangeCount := sqlite3_changes(fSQLite);
|
||||
fTable := nil;
|
||||
fBusy := False;
|
||||
if Assigned(fOnQueryComplete) then
|
||||
fOnQueryComplete(Self);
|
||||
end;
|
||||
fMsg := ErrorMessage(fError);
|
||||
Result := (fError = SQLITE_OK);
|
||||
end;
|
||||
{*************************************************************}
|
||||
function TSQLite.Cancel: boolean;
|
||||
{*************************************************************
|
||||
SQLite3 interrupt database
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
Result := False;
|
||||
if fBusy and fIsOpen then
|
||||
begin
|
||||
sqlite3_interrupt(fSQLite);
|
||||
fBusy := false;
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
{*************************************************************}
|
||||
procedure TSQLite.SetBusyTimeout(Timeout: Integer);
|
||||
{*************************************************************
|
||||
SQLite3 busy timeout
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
fBusyTimeout := Timeout;
|
||||
if fIsOpen then
|
||||
begin
|
||||
fError:=sqlite3_busy_timeout(fSQLite, fBusyTimeout);
|
||||
if fBusyTimeout > 0 then
|
||||
sqlite3_busy_handler(fSQLite, @BusyCallback, Self)
|
||||
else
|
||||
sqlite3_busy_handler(fSQLite, nil, nil);
|
||||
end;
|
||||
end;
|
||||
{*************************************************************}
|
||||
function TSQLite.LastInsertRow: longint;
|
||||
{*************************************************************
|
||||
SQLite3 Get ID of the last inserted row
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
if fIsOpen then
|
||||
Result := sqlite3_last_insert_rowid(fSQLite)
|
||||
else
|
||||
Result := -1;
|
||||
end;
|
||||
{*************************************************************}
|
||||
function TSQLite.ErrorMessage(ErrNo: Integer): string;
|
||||
{*************************************************************
|
||||
SQLite3 Return comprehensive error message
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
if ErrNo = 0 then
|
||||
Result := MsgNoError
|
||||
else
|
||||
Result := sqlite3_errmsg(fSQLite);
|
||||
end;
|
||||
{*************************************************************}
|
||||
function TSQLite.IsComplete(Sql: String): boolean;
|
||||
{*************************************************************
|
||||
SQLite3 Return true when complete
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
var Psql : pchar;
|
||||
begin
|
||||
Psql:=StrAlloc (length(Sql)+1);
|
||||
strpcopy(Psql,Sql);
|
||||
// Writeln('Testing: ',psql);
|
||||
Result := sqlite3_complete(Psql)<>0;
|
||||
strdispose(Psql);
|
||||
end;
|
||||
{*************************************************************}
|
||||
function TSQLite.DatabaseDetails(Table: TStrings): boolean;
|
||||
{*************************************************************
|
||||
SQLite3 Query the database
|
||||
G. Marcou
|
||||
*************************************************************}
|
||||
begin
|
||||
Result := Query('SELECT * FROM SQLITE_MASTER;', Table);
|
||||
end;
|
||||
{*************************************************************}
|
||||
{*************************************************************}
|
||||
initialization
|
||||
|
||||
finalization
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user