diff --git a/.gitattributes b/.gitattributes index f49cf53980..68993ea411 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/packages/base/sqlite/Makefile b/packages/base/sqlite/Makefile index 07f294a19c..b40ad8114b 100644 --- a/packages/base/sqlite/Makefile +++ b/packages/base/sqlite/Makefile @@ -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 diff --git a/packages/base/sqlite/Makefile.fpc b/packages/base/sqlite/Makefile.fpc index 0827af757f..e99ade7092 100644 --- a/packages/base/sqlite/Makefile.fpc +++ b/packages/base/sqlite/Makefile.fpc @@ -7,7 +7,7 @@ name=sqlite version=2.0.0 [target] -units=sqlite sqlite3 sqlitedb +units=sqlite sqlite3 sqlitedb sqlitedb3 [require] diff --git a/packages/base/sqlite/sqlite3db.pas b/packages/base/sqlite/sqlite3db.pas new file mode 100644 index 0000000000..a7625b00db --- /dev/null +++ b/packages/base/sqlite/sqlite3db.pas @@ -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.