git-svn-id: trunk@6880 -
@@ -4078,53 +4078,6 @@ packages/fcl-db/src/sqlite/fpmake.pp svneol=native#text/plain
packages/fcl-db/src/sqlite/sqlite3ds.pas svneol=native#text/plain
packages/fcl-db/src/sqlite/sqliteds.pas svneol=native#text/plain
packages/fcl-db/src/sqlite/testds.pas svneol=native#text/plain
-packages/fcl-db/src/unmaintained/Makefile -text
-packages/fcl-db/src/unmaintained/Makefile.fpc -text
-packages/fcl-db/src/unmaintained/README -text
-packages/fcl-db/src/unmaintained/ddg/Makefile svneol=native#text/plain
-packages/fcl-db/src/unmaintained/ddg/Makefile.fpc svneol=native#text/plain
-packages/fcl-db/src/unmaintained/ddg/createds.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/ddg/ddg_ds.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/ddg/ddg_rec.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/ddg/fpmake.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/ddg/testds.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/ddg/tested.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/interbase/BUGS.known -text
-packages/fcl-db/src/unmaintained/interbase/Makefile svneol=native#text/plain
-packages/fcl-db/src/unmaintained/interbase/Makefile.fpc svneol=native#text/plain
-packages/fcl-db/src/unmaintained/interbase/README -text
-packages/fcl-db/src/unmaintained/interbase/fpmake.inc svneol=native#text/plain
-packages/fcl-db/src/unmaintained/interbase/fpmake.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/interbase/interbase.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/interbase/mkdb -text
-packages/fcl-db/src/unmaintained/interbase/testib.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/mysql/Makefile svneol=native#text/plain
-packages/fcl-db/src/unmaintained/mysql/Makefile.fpc svneol=native#text/plain
-packages/fcl-db/src/unmaintained/mysql/fpmake.inc svneol=native#text/plain
-packages/fcl-db/src/unmaintained/mysql/fpmake.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/mysql/mtest.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/mysql/mysqldb3.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/mysql/mysqldb4.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/Makefile svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/Makefile.fpc svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/README -text
-packages/fcl-db/src/unmaintained/odbc/fpmake.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/fpodbc.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testbcon.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testcon.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testdrcon.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testenv.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testfl.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testodbc.mdb -text
-packages/fcl-db/src/unmaintained/odbc/testpa.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testpk.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testpr.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testsql.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testst.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/odbc/testtl.pp svneol=native#text/plain
-packages/fcl-db/src/unmaintained/sqlite/Makefile -text
-packages/fcl-db/src/unmaintained/sqlite/Makefile.fpc -text
-packages/fcl-db/src/unmaintained/sqlite/sqlitedataset.pas svneol=native#text/plain
packages/fcl-db/tests/Makefile -text
packages/fcl-db/tests/Makefile.fpc -text
packages/fcl-db/tests/README.txt svneol=native#text/plain
@@ -1545,34 +1545,6 @@ packages/fcl-db/src/sqlite/*.s
packages/fcl-db/src/sqlite/fpcmade.*
packages/fcl-db/src/sqlite/units
packages/fcl-db/src/units
-packages/fcl-db/src/unmaintained/ddg/*.bak
-packages/fcl-db/src/unmaintained/ddg/*.exe
-packages/fcl-db/src/unmaintained/ddg/*.o
-packages/fcl-db/src/unmaintained/ddg/*.ppu
-packages/fcl-db/src/unmaintained/ddg/*.s
-packages/fcl-db/src/unmaintained/ddg/fpcmade.*
-packages/fcl-db/src/unmaintained/ddg/units
-packages/fcl-db/src/unmaintained/interbase/*.bak
-packages/fcl-db/src/unmaintained/interbase/*.exe
-packages/fcl-db/src/unmaintained/interbase/*.o
-packages/fcl-db/src/unmaintained/interbase/*.ppu
-packages/fcl-db/src/unmaintained/interbase/*.s
-packages/fcl-db/src/unmaintained/interbase/fpcmade.*
-packages/fcl-db/src/unmaintained/interbase/units
-packages/fcl-db/src/unmaintained/mysql/*.bak
-packages/fcl-db/src/unmaintained/mysql/*.exe
-packages/fcl-db/src/unmaintained/mysql/*.o
-packages/fcl-db/src/unmaintained/mysql/*.ppu
-packages/fcl-db/src/unmaintained/mysql/*.s
-packages/fcl-db/src/unmaintained/mysql/fpcmade.*
-packages/fcl-db/src/unmaintained/mysql/units
-packages/fcl-db/src/unmaintained/odbc/*.bak
-packages/fcl-db/src/unmaintained/odbc/*.exe
-packages/fcl-db/src/unmaintained/odbc/*.o
-packages/fcl-db/src/unmaintained/odbc/*.ppu
-packages/fcl-db/src/unmaintained/odbc/*.s
-packages/fcl-db/src/unmaintained/odbc/fpcmade.*
-packages/fcl-db/src/unmaintained/odbc/units
packages/fcl-fpcunit/src/*.bak
packages/fcl-fpcunit/src/*.exe
packages/fcl-fpcunit/src/*.o
@@ -1,8 +1,8 @@
#
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/03/04]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/03/15]
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-darwin 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 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
BSDs = freebsd netbsd openbsd darwin
UNIXs = linux $(BSDs) solaris qnx
LIMIT83fs = go32v2 os2 emx watcom
@@ -233,160 +233,157 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
override PACKAGE_NAME=fcl-db
override PACKAGE_VERSION=2.0.0
ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_DIRS+=src/sdf src/memds src/sqldb src/unmaintained src/dbase src/sqlite
+override TARGET_DIRS+=src/sdf src/memds src/sqldb src/dbase src/sqlite
endif
ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_DIRS+=src/sdf src/memds src/sqldb src/unmaintained
+override TARGET_DIRS+=src/sdf src/memds src/sqldb
ifeq ($(FULL_TARGET),i386-win32)
ifeq ($(FULL_TARGET),i386-os2)
ifeq ($(FULL_TARGET),i386-freebsd)
ifeq ($(FULL_TARGET),i386-beos)
ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_DIRS+=src/sdf src/memds src/sqldb src/unmaintained src/sqlite
+override TARGET_DIRS+=src/sdf src/memds src/sqldb src/sqlite
ifeq ($(FULL_TARGET),i386-solaris)
ifeq ($(FULL_TARGET),i386-qnx)
ifeq ($(FULL_TARGET),i386-netware)
ifeq ($(FULL_TARGET),i386-openbsd)
ifeq ($(FULL_TARGET),i386-wdosx)
ifeq ($(FULL_TARGET),i386-darwin)
ifeq ($(FULL_TARGET),i386-emx)
ifeq ($(FULL_TARGET),i386-watcom)
ifeq ($(FULL_TARGET),i386-netwlibc)
ifeq ($(FULL_TARGET),i386-wince)
ifeq ($(FULL_TARGET),i386-embedded)
ifeq ($(FULL_TARGET),i386-symbian)
ifeq ($(FULL_TARGET),m68k-linux)
ifeq ($(FULL_TARGET),m68k-freebsd)
ifeq ($(FULL_TARGET),m68k-netbsd)
ifeq ($(FULL_TARGET),m68k-amiga)
ifeq ($(FULL_TARGET),m68k-atari)
ifeq ($(FULL_TARGET),m68k-openbsd)
ifeq ($(FULL_TARGET),m68k-palmos)
ifeq ($(FULL_TARGET),m68k-embedded)
ifeq ($(FULL_TARGET),powerpc-linux)
ifeq ($(FULL_TARGET),powerpc-netbsd)
ifeq ($(FULL_TARGET),powerpc-amiga)
ifeq ($(FULL_TARGET),powerpc-macos)
ifeq ($(FULL_TARGET),powerpc-darwin)
ifeq ($(FULL_TARGET),powerpc-morphos)
ifeq ($(FULL_TARGET),powerpc-embedded)
ifeq ($(FULL_TARGET),sparc-linux)
ifeq ($(FULL_TARGET),sparc-netbsd)
ifeq ($(FULL_TARGET),sparc-solaris)
ifeq ($(FULL_TARGET),sparc-embedded)
ifeq ($(FULL_TARGET),x86_64-linux)
ifeq ($(FULL_TARGET),x86_64-freebsd)
ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_DIRS+=src/sdf src/memds src/sqldb src/unmaintained src/dbase
+override TARGET_DIRS+=src/sdf src/memds src/sqldb src/dbase
ifeq ($(FULL_TARGET),x86_64-embedded)
ifeq ($(FULL_TARGET),arm-linux)
ifeq ($(FULL_TARGET),arm-palmos)
ifeq ($(FULL_TARGET),arm-wince)
ifeq ($(FULL_TARGET),arm-gba)
ifeq ($(FULL_TARGET),arm-nds)
ifeq ($(FULL_TARGET),arm-embedded)
ifeq ($(FULL_TARGET),arm-symbian)
ifeq ($(FULL_TARGET),powerpc64-linux)
-endif
-ifeq ($(FULL_TARGET),powerpc64-darwin)
ifeq ($(FULL_TARGET),powerpc64-embedded)
override TARGET_UNITS+=dbconst db dbwhtml bufdataset_parser bufdataset
@@ -538,9 +535,6 @@ endif
-override TARGET_UNITS+=dbconst db dbwhtml bufdataset_parser bufdataset
@@ -694,9 +688,6 @@ endif
override TARGET_RSTS+=dbwhtml dbconst
-override TARGET_RSTS+=dbwhtml dbconst
@@ -851,9 +842,6 @@ endif
override COMPILER_OPTIONS+=-S2h
-override COMPILER_OPTIONS+=-S2h
@@ -1007,9 +995,6 @@ endif
override COMPILER_UNITDIR+=src/dbase
-override COMPILER_UNITDIR+=src/dbase
@@ -1163,9 +1148,6 @@ endif
override COMPILER_SOURCEDIR+=src
-override COMPILER_SOURCEDIR+=src
@@ -2430,21 +2412,6 @@ REQUIRE_PACKAGES_ODBC=1
REQUIRE_PACKAGES_ORACLE=1
REQUIRE_PACKAGES_SQLITE=1
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_HASH=1
-REQUIRE_PACKAGES_PASZLIB=1
-REQUIRE_PACKAGES_NETDB=1
-REQUIRE_PACKAGES_LIBASYNC=1
-REQUIRE_PACKAGES_PTHREADS=1
-REQUIRE_PACKAGES_FCL-BASE=1
-REQUIRE_PACKAGES_IBASE=1
-REQUIRE_PACKAGES_POSTGRES=1
-REQUIRE_PACKAGES_MYSQL=1
-REQUIRE_PACKAGES_ODBC=1
-REQUIRE_PACKAGES_ORACLE=1
-REQUIRE_PACKAGES_SQLITE=1
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_HASH=1
@@ -3385,7 +3352,6 @@ ifeq ($(FULL_TARGET),i386-linux)
TARGET_DIRS_SRC/SDF=1
TARGET_DIRS_SRC/MEMDS=1
TARGET_DIRS_SRC/SQLDB=1
-TARGET_DIRS_SRC/UNMAINTAINED=1
TARGET_DIRS_SRC/DBASE=1
TARGET_DIRS_SRC/SQLITE=1
@@ -3393,13 +3359,11 @@ ifeq ($(FULL_TARGET),i386-go32v2)
@@ -3407,13 +3371,11 @@ ifeq ($(FULL_TARGET),i386-os2)
@@ -3421,76 +3383,64 @@ ifeq ($(FULL_TARGET),i386-beos)
@@ -3498,19 +3448,16 @@ ifeq ($(FULL_TARGET),i386-embedded)
@@ -3518,7 +3465,6 @@ ifeq ($(FULL_TARGET),m68k-freebsd)
@@ -3526,45 +3472,38 @@ ifeq ($(FULL_TARGET),m68k-netbsd)
@@ -3572,45 +3511,38 @@ ifeq ($(FULL_TARGET),powerpc-netbsd)
@@ -3618,26 +3550,22 @@ ifeq ($(FULL_TARGET),sparc-netbsd)
@@ -3645,7 +3573,6 @@ ifeq ($(FULL_TARGET),x86_64-freebsd)
@@ -3653,20 +3580,17 @@ ifeq ($(FULL_TARGET),x86_64-win64)
@@ -3674,13 +3598,11 @@ ifeq ($(FULL_TARGET),arm-palmos)
@@ -3688,46 +3610,33 @@ ifeq ($(FULL_TARGET),arm-gba)
-TARGET_DIRS_SRC/SDF=1
-TARGET_DIRS_SRC/MEMDS=1
-TARGET_DIRS_SRC/SQLDB=1
-TARGET_DIRS_SRC/SQLITE=1
ifdef TARGET_DIRS_SRC/SDF
src/sdf_all:
@@ -3864,51 +3773,6 @@ src/sqldb:
$(MAKE) -C src/sqldb all
.PHONY: src/sqldb_all src/sqldb_debug src/sqldb_smart src/sqldb_release src/sqldb_units src/sqldb_examples src/sqldb_shared src/sqldb_install src/sqldb_sourceinstall src/sqldb_exampleinstall src/sqldb_distinstall src/sqldb_zipinstall src/sqldb_zipsourceinstall src/sqldb_zipexampleinstall src/sqldb_zipdistinstall src/sqldb_clean src/sqldb_distclean src/sqldb_cleanall src/sqldb_info src/sqldb_makefiles src/sqldb
-ifdef TARGET_DIRS_SRC/UNMAINTAINED
-src/unmaintained_all:
- $(MAKE) -C src/unmaintained all
-src/unmaintained_debug:
- $(MAKE) -C src/unmaintained debug
-src/unmaintained_smart:
- $(MAKE) -C src/unmaintained smart
-src/unmaintained_release:
- $(MAKE) -C src/unmaintained release
-src/unmaintained_units:
- $(MAKE) -C src/unmaintained units
-src/unmaintained_examples:
- $(MAKE) -C src/unmaintained examples
-src/unmaintained_shared:
- $(MAKE) -C src/unmaintained shared
-src/unmaintained_install:
- $(MAKE) -C src/unmaintained install
-src/unmaintained_sourceinstall:
- $(MAKE) -C src/unmaintained sourceinstall
-src/unmaintained_exampleinstall:
- $(MAKE) -C src/unmaintained exampleinstall
-src/unmaintained_distinstall:
- $(MAKE) -C src/unmaintained distinstall
-src/unmaintained_zipinstall:
- $(MAKE) -C src/unmaintained zipinstall
-src/unmaintained_zipsourceinstall:
- $(MAKE) -C src/unmaintained zipsourceinstall
-src/unmaintained_zipexampleinstall:
- $(MAKE) -C src/unmaintained zipexampleinstall
-src/unmaintained_zipdistinstall:
- $(MAKE) -C src/unmaintained zipdistinstall
-src/unmaintained_clean:
- $(MAKE) -C src/unmaintained clean
-src/unmaintained_distclean:
- $(MAKE) -C src/unmaintained distclean
-src/unmaintained_cleanall:
- $(MAKE) -C src/unmaintained cleanall
-src/unmaintained_info:
- $(MAKE) -C src/unmaintained info
-src/unmaintained_makefiles:
- $(MAKE) -C src/unmaintained makefiles
-src/unmaintained:
-.PHONY: src/unmaintained_all src/unmaintained_debug src/unmaintained_smart src/unmaintained_release src/unmaintained_units src/unmaintained_examples src/unmaintained_shared src/unmaintained_install src/unmaintained_sourceinstall src/unmaintained_exampleinstall src/unmaintained_distinstall src/unmaintained_zipinstall src/unmaintained_zipsourceinstall src/unmaintained_zipexampleinstall src/unmaintained_zipdistinstall src/unmaintained_clean src/unmaintained_distclean src/unmaintained_cleanall src/unmaintained_info src/unmaintained_makefiles src/unmaintained
ifdef TARGET_DIRS_SRC/DBASE
src/dbase_all:
$(MAKE) -C src/dbase all
@@ -7,7 +7,7 @@ name=fcl-db
version=2.0.0
[target]
-dirs=src/sdf src/memds src/sqldb src/unmaintained
+dirs=src/sdf src/memds src/sqldb
dirs_linux=src/dbase src/sqlite
dirs_freebsd=src/dbase src/sqlite
dirs_darwin=src/sqlite
@@ -1,2223 +0,0 @@
-#
-default: all
-BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx
-LIMIT83fs = go32v2 os2 emx watcom
-FORCE:
-.PHONY: FORCE
-override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
-ifneq ($(findstring darwin,$(OSTYPE)),)
-inUnix=1 #darwin
-SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
-else
-ifeq ($(findstring ;,$(PATH)),)
-inUnix=1
-SEARCHPATH:=$(subst ;, ,$(PATH))
-SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
-$(error You need the GNU utils package to use this Makefile)
-PWD:=$(firstword $(PWD))
-SRCEXEEXT=
-SRCEXEEXT=.exe
-ifndef inUnix
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-ifdef OS2_SHELL
-inOS2=1
-ifneq ($(findstring cygdrive,$(PATH)),)
-inCygWin=1
-ifdef inUnix
-SRCBATCHEXT=.sh
-ifdef inOS2
-SRCBATCHEXT=.cmd
-SRCBATCHEXT=.bat
-PATHSEP=/
-PATHSEP:=$(subst /,\,/)
-ifdef inCygWin
-ifdef PWD
-BASEDIR:=$(subst \,/,$(shell $(PWD)))
-ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
-BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
-BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
-BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
-BASEDIR=.
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
-ECHO=echo
-ECHO:=$(firstword $(ECHO))
-export ECHO
-override DEFAULT_FPCDIR=../../../..
-ifndef FPC
-ifdef PP
-FPC=$(PP)
-FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
-ifneq ($(FPCPROG),)
-FPCPROG:=$(firstword $(FPCPROG))
-FPC:=$(shell $(FPCPROG) -PB)
-ifneq ($(findstring Error,$(FPC)),)
-override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
-override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
-override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
-FOUNDFPC:=$(strip $(wildcard $(FPC)))
-ifeq ($(FOUNDFPC),)
-FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
-$(error Compiler $(FPC) not found)
-ifndef FPC_COMPILERINFO
-FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
-ifndef FPC_VERSION
-FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
-export FPC FPC_VERSION FPC_COMPILERINFO
-unexport CHECKDEPEND ALLDEPENDENCIES
-ifndef CPU_TARGET
-ifdef CPU_TARGET_DEFAULT
-CPU_TARGET=$(CPU_TARGET_DEFAULT)
-ifndef OS_TARGET
-ifdef OS_TARGET_DEFAULT
-OS_TARGET=$(OS_TARGET_DEFAULT)
-ifneq ($(words $(FPC_COMPILERINFO)),5)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
-CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
-ifndef OS_SOURCE
-OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
-OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
-FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
-FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
-ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
-TARGETSUFFIX=$(OS_TARGET)
-SOURCESUFFIX=$(OS_SOURCE)
-TARGETSUFFIX=$(FULL_TARGET)
-SOURCESUFFIX=$(FULL_SOURCE)
-ifneq ($(FULL_TARGET),$(FULL_SOURCE))
-CROSSCOMPILE=1
-ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
-ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
-$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
-ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
-BSDhier=1
-ifeq ($(OS_TARGET),linux)
-linuxHier=1
-export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR=wrong
-ifdef DEFAULT_FPCDIR
-ifeq ($(FPCDIR),wrong)
-override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
-override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
-ifeq ($(wildcard $(FPCDIR)/units),)
-override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
-override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
-override FPCDIR:=$(FPCDIR)/..
-override FPCDIR:=$(BASEDIR)
-override FPCDIR=c:/pp
-ifndef CROSSBINDIR
-CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
-ifndef BINUTILSPREFIX
-ifdef CROSSCOMPILE
-BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
-UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
-ifeq ($(UNITSDIR),)
-UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
-PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
-override PACKAGE_NAME=fcl-db
-PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR))))))
-ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_DIRS+=ddg mysql interbase
-ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_DIRS+=ddg
-ifeq ($(FULL_TARGET),i386-win32)
-ifeq ($(FULL_TARGET),i386-os2)
-ifeq ($(FULL_TARGET),i386-freebsd)
-ifeq ($(FULL_TARGET),i386-beos)
-ifeq ($(FULL_TARGET),i386-netbsd)
-ifeq ($(FULL_TARGET),i386-solaris)
-ifeq ($(FULL_TARGET),i386-qnx)
-ifeq ($(FULL_TARGET),i386-netware)
-ifeq ($(FULL_TARGET),i386-openbsd)
-ifeq ($(FULL_TARGET),i386-wdosx)
-ifeq ($(FULL_TARGET),i386-darwin)
-ifeq ($(FULL_TARGET),i386-emx)
-ifeq ($(FULL_TARGET),i386-watcom)
-ifeq ($(FULL_TARGET),i386-netwlibc)
-ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_DIRS+=ddg interbase
-ifeq ($(FULL_TARGET),i386-embedded)
-ifeq ($(FULL_TARGET),i386-symbian)
-ifeq ($(FULL_TARGET),m68k-linux)
-ifeq ($(FULL_TARGET),m68k-freebsd)
-ifeq ($(FULL_TARGET),m68k-netbsd)
-ifeq ($(FULL_TARGET),m68k-amiga)
-ifeq ($(FULL_TARGET),m68k-atari)
-ifeq ($(FULL_TARGET),m68k-openbsd)
-ifeq ($(FULL_TARGET),m68k-palmos)
-ifeq ($(FULL_TARGET),m68k-embedded)
-ifeq ($(FULL_TARGET),powerpc-linux)
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-ifeq ($(FULL_TARGET),powerpc-amiga)
-ifeq ($(FULL_TARGET),powerpc-macos)
-ifeq ($(FULL_TARGET),powerpc-darwin)
-ifeq ($(FULL_TARGET),powerpc-morphos)
-ifeq ($(FULL_TARGET),powerpc-embedded)
-ifeq ($(FULL_TARGET),sparc-linux)
-ifeq ($(FULL_TARGET),sparc-netbsd)
-ifeq ($(FULL_TARGET),sparc-solaris)
-ifeq ($(FULL_TARGET),sparc-embedded)
-ifeq ($(FULL_TARGET),x86_64-linux)
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-ifeq ($(FULL_TARGET),x86_64-win64)
-ifeq ($(FULL_TARGET),x86_64-embedded)
-ifeq ($(FULL_TARGET),arm-linux)
-ifeq ($(FULL_TARGET),arm-palmos)
-ifeq ($(FULL_TARGET),arm-wince)
-ifeq ($(FULL_TARGET),arm-gba)
-ifeq ($(FULL_TARGET),arm-nds)
-ifeq ($(FULL_TARGET),arm-embedded)
-ifeq ($(FULL_TARGET),arm-symbian)
-ifeq ($(FULL_TARGET),powerpc64-linux)
-ifeq ($(FULL_TARGET),powerpc64-embedded)
-override INSTALL_FPCPACKAGE=y
-override COMPILER_OPTIONS+=-S2
-ifdef REQUIRE_UNITSDIR
-override UNITSDIR+=$(REQUIRE_UNITSDIR)
-ifdef REQUIRE_PACKAGESDIR
-override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
-ifdef ZIPINSTALL
-ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
-UNIXHier=1
-ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
-ifndef INSTALL_PREFIX
-ifdef PREFIX
-INSTALL_PREFIX=$(PREFIX)
-ifdef UNIXHier
-INSTALL_PREFIX=/usr/local
-ifdef INSTALL_FPCPACKAGE
-INSTALL_BASEDIR:=/pp
-INSTALL_BASEDIR:=/$(PACKAGE_NAME)
-export INSTALL_PREFIX
-ifdef INSTALL_FPCSUBDIR
-export INSTALL_FPCSUBDIR
-ifndef DIST_DESTDIR
-DIST_DESTDIR:=$(BASEDIR)
-export DIST_DESTDIR
-ifndef COMPILER_UNITTARGETDIR
-ifdef PACKAGEDIR_MAIN
-COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
-COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
-ifndef COMPILER_TARGETDIR
-COMPILER_TARGETDIR=.
-ifndef INSTALL_BASEDIR
-INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
-INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
-INSTALL_BASEDIR:=$(INSTALL_PREFIX)
-ifndef INSTALL_BINDIR
-INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
-ifdef CROSSINSTALL
-INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
-INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
-ifndef INSTALL_UNITDIR
-INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
-ifdef PACKAGE_NAME
-INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
-ifndef INSTALL_LIBDIR
-INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
-INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
-ifndef INSTALL_SOURCEDIR
-ifdef BSDhier
-SRCPREFIXDIR=share/src
-ifdef linuxHier
-SRCPREFIXDIR=src
-INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
-INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
-INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
-INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
-INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
-ifndef INSTALL_DOCDIR
-DOCPREFIXDIR=share/doc
-DOCPREFIXDIR=doc
-INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
-INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
-INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
-ifndef INSTALL_EXAMPLEDIR
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
-INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
-INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
-ifndef INSTALL_DATADIR
-INSTALL_DATADIR=$(INSTALL_BASEDIR)
-ifndef INSTALL_SHAREDDIR
-INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
-CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
-ifeq ($(CROSSBINDIR),)
-CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
-CROSSBINDIR=
-ifeq ($(OS_SOURCE),linux)
-ifndef GCCLIBDIR
-ifeq ($(CPU_TARGET),i386)
-ifneq ($(findstring x86_64,$(shell uname -a)),)
-ifeq ($(BINUTILSPREFIX),)
-GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)
-ifeq ($(CPU_TARGET),powerpc64)
-GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`)
-CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH))))
-ifneq ($(CROSSGCC),)
-GCCLIBDIR:=$(shell dirname `$(CROSSGCC) -print-libgcc-file-name`)
-ifndef OTHERLIBDIR
-OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '{ ORS=" "; print $1 }')
-ifeq ($(OS_SOURCE),netbsd)
-OTHERLIBDIR+=/usr/pkg/lib
-export GCCLIBDIR OTHERLIB
-BATCHEXT=.bat
-LOADEREXT=.as
-EXEEXT=.exe
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-SHAREDLIBPREFIX=libfp
-STATICLIBPREFIX=libp
-IMPORTLIBPREFIX=libimp
-RSTEXT=.rst
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),go32v1)
-STATICLIBPREFIX=
-SHORTSUFFIX=v1
-ifeq ($(OS_TARGET),go32v2)
-SHORTSUFFIX=dos
-ifeq ($(OS_TARGET),watcom)
-OEXT=.obj
-ASMEXT=.asm
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=wat
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=lnx
-ifeq ($(OS_TARGET),freebsd)
-SHORTSUFFIX=fbs
-ifeq ($(OS_TARGET),netbsd)
-SHORTSUFFIX=nbs
-ifeq ($(OS_TARGET),openbsd)
-SHORTSUFFIX=obs
-ifeq ($(OS_TARGET),win32)
-SHORTSUFFIX=w32
-ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
-AOUTEXT=.out
-SHORTSUFFIX=os2
-ifeq ($(OS_TARGET),emx)
-SHORTSUFFIX=emx
-ifeq ($(OS_TARGET),amiga)
-SHAREDLIBEXT=.library
-SHORTSUFFIX=amg
-ifeq ($(OS_TARGET),morphos)
-SHORTSUFFIX=mos
-ifeq ($(OS_TARGET),atari)
-EXEEXT=.ttp
-SHORTSUFFIX=ata
-ifeq ($(OS_TARGET),beos)
-SHORTSUFFIX=be
-ifeq ($(OS_TARGET),solaris)
-SHORTSUFFIX=sun
-ifeq ($(OS_TARGET),qnx)
-SHORTSUFFIX=qnx
-ifeq ($(OS_TARGET),netware)
-EXEEXT=.nlm
-SHORTSUFFIX=nw
-ifeq ($(OS_TARGET),netwlibc)
-SHORTSUFFIX=nwl
-ifeq ($(OS_TARGET),macos)
-BATCHEXT=
-DEBUGSYMEXT=.xcoff
-SHORTSUFFIX=mac
-ifeq ($(OS_TARGET),darwin)
-SHORTSUFFIX=dwn
-ifeq ($(OS_TARGET),gba)
-EXEEXT=.gba
-SHORTSUFFIX=gba
-ifeq ($(OS_TARGET),symbian)
-SHORTSUFFIX=symbian
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.sl2
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.nlm
-FPCMADE=fpcmade.$(SHORTSUFFIX)
-ZIPSUFFIX=$(SHORTSUFFIX)
-ZIPCROSSPREFIX=
-ZIPSOURCESUFFIX=src
-ZIPEXAMPLESUFFIX=exm
-FPCMADE=fpcmade.$(TARGETSUFFIX)
-ZIPSOURCESUFFIX=.source
-ZIPEXAMPLESUFFIX=.examples
-ZIPSUFFIX=.$(SOURCESUFFIX)
-ZIPCROSSPREFIX=$(TARGETSUFFIX)-
-ZIPSUFFIX=.$(TARGETSUFFIX)
-ECHO= __missing_command_ECHO
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
-DATE= __missing_command_DATE
-DATE:=$(firstword $(DATE))
-export DATE
-ifndef GINSTALL
-GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(GINSTALL),)
-GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
-GINSTALL= __missing_command_GINSTALL
-GINSTALL:=$(firstword $(GINSTALL))
-export GINSTALL
-ifndef CPPROG
-CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(CPPROG),)
-CPPROG= __missing_command_CPPROG
-CPPROG:=$(firstword $(CPPROG))
-export CPPROG
-ifndef RMPROG
-RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(RMPROG),)
-RMPROG= __missing_command_RMPROG
-RMPROG:=$(firstword $(RMPROG))
-export RMPROG
-ifndef MVPROG
-MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(MVPROG),)
-MVPROG= __missing_command_MVPROG
-MVPROG:=$(firstword $(MVPROG))
-export MVPROG
-ifndef MKDIRPROG
-MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(MKDIRPROG),)
-MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
-MKDIRPROG= __missing_command_MKDIRPROG
-MKDIRPROG:=$(firstword $(MKDIRPROG))
-export MKDIRPROG
-ifndef ECHOREDIR
-ECHOREDIR=echo
-ECHOREDIR=$(ECHO)
-ifndef COPY
-COPY:=$(CPPROG) -fp
-ifndef COPYTREE
-COPYTREE:=$(CPPROG) -Rfp
-ifndef MKDIRTREE
-MKDIRTREE:=$(MKDIRPROG) -p
-ifndef MOVE
-MOVE:=$(MVPROG) -f
-ifndef DEL
-DEL:=$(RMPROG) -f
-ifndef DELTREE
-DELTREE:=$(RMPROG) -rf
-ifndef INSTALL
-INSTALL:=$(GINSTALL) -c -m 644
-INSTALL:=$(COPY)
-ifndef INSTALLEXE
-INSTALLEXE:=$(GINSTALL) -c -m 755
-INSTALLEXE:=$(COPY)
-ifndef MKDIR
-MKDIR:=$(GINSTALL) -m 755 -d
-export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE= __missing_command_PPUMOVE
-PPUMOVE:=$(firstword $(PPUMOVE))
-export PPUMOVE
-ifndef FPCMAKE
-FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(FPCMAKE),)
-FPCMAKE= __missing_command_FPCMAKE
-FPCMAKE:=$(firstword $(FPCMAKE))
-export FPCMAKE
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG= __missing_command_ZIPPROG
-ZIPPROG:=$(firstword $(ZIPPROG))
-export ZIPPROG
-ifndef TARPROG
-TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(TARPROG),)
-TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
-TARPROG= __missing_command_TARPROG
-TARPROG:=$(firstword $(TARPROG))
-export TARPROG
-ASNAME=$(BINUTILSPREFIX)as
-LDNAME=$(BINUTILSPREFIX)ld
-ARNAME=$(BINUTILSPREFIX)ar
-RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-ASNAME=asw
-LDNAME=ldw
-ARNAME=arw
-ifndef ASPROG
-ifdef CROSSBINDIR
-ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
-ASPROG=$(ASNAME)
-ifndef LDPROG
-LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
-LDPROG=$(LDNAME)
-ifndef RCPROG
-RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
-RCPROG=$(RCNAME)
-ifndef ARPROG
-ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
-ARPROG=$(ARNAME)
-AS=$(ASPROG)
-LD=$(LDPROG)
-RC=$(RCPROG)
-AR=$(ARPROG)
-PPAS=ppas$(SRCBATCHEXT)
-LDCONFIG=ldconfig
-LDCONFIG=
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-DATESTR=
-ifndef UPXPROG
-UPXPROG:=1
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-UPXPROG:=$(firstword $(UPXPROG))
-export UPXPROG
-ZIPOPT=-9
-ZIPEXT=.zip
-ifeq ($(USETAR),bz2)
-TAROPT=vj
-TAREXT=.tar.bz2
-TAROPT=vz
-TAREXT=.tar.gz
-ifdef REQUIRE_PACKAGES_MYSQL
-PACKAGEDIR_MYSQL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /mysql/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_MYSQL),)
-ifneq ($(wildcard $(PACKAGEDIR_MYSQL)/units/$(TARGETSUFFIX)),)
-UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)/units/$(TARGETSUFFIX)
-UNITDIR_MYSQL=$(PACKAGEDIR_MYSQL)
-ifdef CHECKDEPEND
-$(PACKAGEDIR_MYSQL)/$(FPCMADE):
- $(MAKE) -C $(PACKAGEDIR_MYSQL) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_MYSQL)/$(FPCMADE)
-PACKAGEDIR_MYSQL=
-UNITDIR_MYSQL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /mysql/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_MYSQL),)
-UNITDIR_MYSQL:=$(firstword $(UNITDIR_MYSQL))
-UNITDIR_MYSQL=
-ifdef UNITDIR_MYSQL
-override COMPILER_UNITDIR+=$(UNITDIR_MYSQL)
-ifdef REQUIRE_PACKAGES_IBASE
-PACKAGEDIR_IBASE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /ibase/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_IBASE),)
-ifneq ($(wildcard $(PACKAGEDIR_IBASE)/units/$(TARGETSUFFIX)),)
-UNITDIR_IBASE=$(PACKAGEDIR_IBASE)/units/$(TARGETSUFFIX)
-UNITDIR_IBASE=$(PACKAGEDIR_IBASE)
-$(PACKAGEDIR_IBASE)/$(FPCMADE):
- $(MAKE) -C $(PACKAGEDIR_IBASE) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_IBASE)/$(FPCMADE)
-PACKAGEDIR_IBASE=
-UNITDIR_IBASE:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /ibase/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_IBASE),)
-UNITDIR_IBASE:=$(firstword $(UNITDIR_IBASE))
-UNITDIR_IBASE=
-ifdef UNITDIR_IBASE
-override COMPILER_UNITDIR+=$(UNITDIR_IBASE)
-ifndef NOCPUDEF
-override FPCOPTDEF=$(CPU_TARGET)
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-ifneq ($(CPU_TARGET),$(CPU_SOURCE))
-override FPCOPT+=-P$(CPU_TARGET)
-ifeq ($(OS_SOURCE),openbsd)
-override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
-ifndef CROSSBOOTSTRAP
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
-override FPCOPT+=-Xr$(RLINKPATH)
-ifdef UNITDIR
-override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
-ifdef LIBDIR
-override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
-ifdef OBJDIR
-override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
-ifdef INCDIR
-override FPCOPT+=$(addprefix -Fi,$(INCDIR))
-ifdef LINKSMART
-override FPCOPT+=-XX
-ifdef CREATESMART
-override FPCOPT+=-CX
-ifdef DEBUG
-override FPCOPT+=-gl
-override FPCOPTDEF+=DEBUG
-ifdef RELEASE
-ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
-FPCCPUOPT:=-OG2p3
-ifeq ($(CPU_TARGET),powerpc)
-FPCCPUOPT:=-O1r
-FPCCPUOPT:=-O2
-override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
-override FPCOPTDEF+=RELEASE
-ifdef STRIP
-override FPCOPT+=-Xs
-ifdef OPTIMIZE
-override FPCOPT+=-O2
-ifdef VERBOSE
-override FPCOPT+=-vwni
-ifdef COMPILER_OPTIONS
-override FPCOPT+=$(COMPILER_OPTIONS)
-ifdef COMPILER_UNITDIR
-override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
-ifdef COMPILER_LIBRARYDIR
-override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
-ifdef COMPILER_OBJECTDIR
-override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
-ifdef COMPILER_INCLUDEDIR
-override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
-override FPCOPT+=-FD$(CROSSBINDIR)
-ifdef COMPILER_TARGETDIR
-override FPCOPT+=-FE$(COMPILER_TARGETDIR)
-ifeq ($(COMPILER_TARGETDIR),.)
-override TARGETDIRPREFIX=
-override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
-ifdef COMPILER_UNITTARGETDIR
-override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
-ifeq ($(COMPILER_UNITTARGETDIR),.)
-override UNITTARGETDIRPREFIX=
-override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
-override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
-override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
-ifdef CREATESHARED
-override FPCOPT+=-Cg
-override FPCOPT+=-Aas
-ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
-ifeq ($(CPU_TARGET),x86_64)
-ifdef LINKSHARED
-ifdef GCCLIBDIR
-override FPCOPT+=-Fl$(GCCLIBDIR)
-ifdef OTHERLIBDIR
-override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR))
-ifdef OPT
-override FPCOPT+=$(OPT)
-ifdef FPCOPTDEF
-override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-ifdef USEENV
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
-override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
-ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
-override ACROSSCOMPILE=1
-ifdef ACROSSCOMPILE
-override FPCOPT+=$(CROSSOPT)
-override COMPILER:=$(FPC) $(FPCOPT)
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-ifeq ($(FULL_SOURCE),$(FULL_TARGET))
-EXECPPAS:=@$(PPAS)
-ifdef TARGET_RSTS
-override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
-override CLEANRSTFILES+=$(RSTFILES)
-.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
-ifdef INSTALL_UNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
-ifdef INSTALL_BUILDUNIT
-override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
-ifdef INSTALLPPUFILES
-override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
-ifneq ($(UNITTARGETDIRPREFIX),)
-override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
-override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
-override INSTALL_CREATEPACKAGEFPC=1
-ifdef INSTALLEXEFILES
-ifneq ($(TARGETDIRPREFIX),)
-override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
-fpc_install: all $(INSTALLTARGET)
- $(MKDIR) $(INSTALL_BINDIR)
- -$(UPXPROG) $(INSTALLEXEFILES)
- $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
-ifdef INSTALL_CREATEPACKAGEFPC
-ifdef FPCMAKE
-ifdef PACKAGE_VERSION
-ifneq ($(wildcard Makefile.fpc),)
- $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
- $(MKDIR) $(INSTALL_UNITDIR)
- $(INSTALL) Package.fpc $(INSTALL_UNITDIR)
- $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
-ifneq ($(INSTALLPPULINKFILES),)
- $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
-ifneq ($(wildcard $(LIB_FULLNAME)),)
- $(MKDIR) $(INSTALL_LIBDIR)
- $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
- ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
-ifdef INSTALL_FILES
- $(MKDIR) $(INSTALL_DATADIR)
- $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
-fpc_sourceinstall: distclean
- $(MKDIR) $(INSTALL_SOURCEDIR)
- $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
-fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
-ifdef HASEXAMPLES
- $(MKDIR) $(INSTALL_EXAMPLEDIR)
-ifdef EXAMPLESOURCEFILES
- $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
-ifdef TARGET_EXAMPLEDIRS
- $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
-.PHONY: fpc_clean fpc_cleanall fpc_distclean
-ifdef EXEFILES
-override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
-ifdef CLEAN_UNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
-ifdef CLEANPPUFILES
-override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
-ifdef DEBUGSYMEXT
-override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
-override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
-override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
- -$(DEL) $(CLEANEXEFILES)
- -$(DEL) $(CLEANPPUFILES)
-ifneq ($(CLEANPPULINKFILES),)
- -$(DEL) $(CLEANPPULINKFILES)
-ifdef CLEANRSTFILES
- -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
-ifdef CLEAN_FILES
- -$(DEL) $(CLEAN_FILES)
-ifdef LIB_NAME
- -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
- -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
- -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
-fpc_cleanall: $(CLEANTARGET)
- -$(DELTREE) units
- -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-ifneq ($(PPUEXT),.ppu)
- -$(DEL) *.o *.ppu *.a
- -$(DELTREE) *$(SMARTEXT)
- -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
- -$(DEL) *_ppas$(BATCHEXT)
-ifdef AOUTEXT
- -$(DEL) *$(AOUTEXT)
- -$(DEL) *$(DEBUGSYMEXT)
-fpc_distclean: cleanall
-.PHONY: fpc_baseinfo
-override INFORULES+=fpc_baseinfo
-fpc_baseinfo:
- @$(ECHO)
- @$(ECHO) == Package info ==
- @$(ECHO) Package Name..... $(PACKAGE_NAME)
- @$(ECHO) Package Version.. $(PACKAGE_VERSION)
- @$(ECHO) == Configuration info ==
- @$(ECHO) FPC.......... $(FPC)
- @$(ECHO) FPC Version.. $(FPC_VERSION)
- @$(ECHO) Source CPU... $(CPU_SOURCE)
- @$(ECHO) Target CPU... $(CPU_TARGET)
- @$(ECHO) Source OS.... $(OS_SOURCE)
- @$(ECHO) Target OS.... $(OS_TARGET)
- @$(ECHO) Full Source.. $(FULL_SOURCE)
- @$(ECHO) Full Target.. $(FULL_TARGET)
- @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
- @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
- @$(ECHO) == Directory info ==
- @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)
- @$(ECHO) Basedir......... $(BASEDIR)
- @$(ECHO) FPCDir.......... $(FPCDIR)
- @$(ECHO) CrossBinDir..... $(CROSSBINDIR)
- @$(ECHO) UnitsDir........ $(UNITSDIR)
- @$(ECHO) PackagesDir..... $(PACKAGESDIR)
- @$(ECHO) GCC library..... $(GCCLIBDIR)
- @$(ECHO) Other library... $(OTHERLIBDIR)
- @$(ECHO) == Tools info ==
- @$(ECHO) As........ $(AS)
- @$(ECHO) Ld........ $(LD)
- @$(ECHO) Ar........ $(AR)
- @$(ECHO) Rc........ $(RC)
- @$(ECHO) Mv........ $(MVPROG)
- @$(ECHO) Cp........ $(CPPROG)
- @$(ECHO) Rm........ $(RMPROG)
- @$(ECHO) GInstall.. $(GINSTALL)
- @$(ECHO) Echo...... $(ECHO)
- @$(ECHO) Shell..... $(SHELL)
- @$(ECHO) Date...... $(DATE)
- @$(ECHO) FPCMake... $(FPCMAKE)
- @$(ECHO) PPUMove... $(PPUMOVE)
- @$(ECHO) Upx....... $(UPXPROG)
- @$(ECHO) Zip....... $(ZIPPROG)
- @$(ECHO) == Object info ==
- @$(ECHO) Target Loaders........ $(TARGET_LOADERS)
- @$(ECHO) Target Units.......... $(TARGET_UNITS)
- @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)
- @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)
- @$(ECHO) Target Dirs........... $(TARGET_DIRS)
- @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)
- @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
- @$(ECHO) Clean Units......... $(CLEAN_UNITS)
- @$(ECHO) Clean Files......... $(CLEAN_FILES)
- @$(ECHO) Install Units....... $(INSTALL_UNITS)
- @$(ECHO) Install Files....... $(INSTALL_FILES)
- @$(ECHO) == Install info ==
- @$(ECHO) DateStr.............. $(DATESTR)
- @$(ECHO) ZipName.............. $(ZIPNAME)
- @$(ECHO) ZipPrefix............ $(ZIPPREFIX)
- @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)
- @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)
- @$(ECHO) FullZipName.......... $(FULLZIPNAME)
- @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)
- @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)
- @$(ECHO) Install binary dir... $(INSTALL_BINDIR)
- @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)
- @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)
- @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)
- @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)
- @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)
- @$(ECHO) Install data dir..... $(INSTALL_DATADIR)
- @$(ECHO) Dist destination dir. $(DIST_DESTDIR)
- @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)
-.PHONY: fpc_info
-fpc_info: $(INFORULES)
-.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
- fpc_makefile_dirs
-fpc_makefile:
- $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
-fpc_makefile_sub1:
-ifdef TARGET_DIRS
- $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
- $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
-fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
-fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
-fpc_makefiles: fpc_makefile fpc_makefile_dirs
-TARGET_DIRS_DDG=1
-TARGET_DIRS_MYSQL=1
-TARGET_DIRS_INTERBASE=1
-ifdef TARGET_DIRS_DDG
-ddg_all:
- $(MAKE) -C ddg all
-ddg_debug:
- $(MAKE) -C ddg debug
-ddg_smart:
- $(MAKE) -C ddg smart
-ddg_release:
- $(MAKE) -C ddg release
-ddg_units:
- $(MAKE) -C ddg units
-ddg_examples:
- $(MAKE) -C ddg examples
-ddg_shared:
- $(MAKE) -C ddg shared
-ddg_install:
- $(MAKE) -C ddg install
-ddg_sourceinstall:
- $(MAKE) -C ddg sourceinstall
-ddg_exampleinstall:
- $(MAKE) -C ddg exampleinstall
-ddg_distinstall:
- $(MAKE) -C ddg distinstall
-ddg_zipinstall:
- $(MAKE) -C ddg zipinstall
-ddg_zipsourceinstall:
- $(MAKE) -C ddg zipsourceinstall
-ddg_zipexampleinstall:
- $(MAKE) -C ddg zipexampleinstall
-ddg_zipdistinstall:
- $(MAKE) -C ddg zipdistinstall
-ddg_clean:
- $(MAKE) -C ddg clean
-ddg_distclean:
- $(MAKE) -C ddg distclean
-ddg_cleanall:
- $(MAKE) -C ddg cleanall
-ddg_info:
- $(MAKE) -C ddg info
-ddg_makefiles:
- $(MAKE) -C ddg makefiles
-ddg:
-.PHONY: ddg_all ddg_debug ddg_smart ddg_release ddg_units ddg_examples ddg_shared ddg_install ddg_sourceinstall ddg_exampleinstall ddg_distinstall ddg_zipinstall ddg_zipsourceinstall ddg_zipexampleinstall ddg_zipdistinstall ddg_clean ddg_distclean ddg_cleanall ddg_info ddg_makefiles ddg
-ifdef TARGET_DIRS_MYSQL
-mysql_all:
- $(MAKE) -C mysql all
-mysql_debug:
- $(MAKE) -C mysql debug
-mysql_smart:
- $(MAKE) -C mysql smart
-mysql_release:
- $(MAKE) -C mysql release
-mysql_units:
- $(MAKE) -C mysql units
-mysql_examples:
- $(MAKE) -C mysql examples
-mysql_shared:
- $(MAKE) -C mysql shared
-mysql_install:
- $(MAKE) -C mysql install
-mysql_sourceinstall:
- $(MAKE) -C mysql sourceinstall
-mysql_exampleinstall:
- $(MAKE) -C mysql exampleinstall
-mysql_distinstall:
- $(MAKE) -C mysql distinstall
-mysql_zipinstall:
- $(MAKE) -C mysql zipinstall
-mysql_zipsourceinstall:
- $(MAKE) -C mysql zipsourceinstall
-mysql_zipexampleinstall:
- $(MAKE) -C mysql zipexampleinstall
-mysql_zipdistinstall:
- $(MAKE) -C mysql zipdistinstall
-mysql_clean:
- $(MAKE) -C mysql clean
-mysql_distclean:
- $(MAKE) -C mysql distclean
-mysql_cleanall:
- $(MAKE) -C mysql cleanall
-mysql_info:
- $(MAKE) -C mysql info
-mysql_makefiles:
- $(MAKE) -C mysql makefiles
-mysql:
-.PHONY: mysql_all mysql_debug mysql_smart mysql_release mysql_units mysql_examples mysql_shared mysql_install mysql_sourceinstall mysql_exampleinstall mysql_distinstall mysql_zipinstall mysql_zipsourceinstall mysql_zipexampleinstall mysql_zipdistinstall mysql_clean mysql_distclean mysql_cleanall mysql_info mysql_makefiles mysql
-ifdef TARGET_DIRS_INTERBASE
-interbase_all:
- $(MAKE) -C interbase all
-interbase_debug:
- $(MAKE) -C interbase debug
-interbase_smart:
- $(MAKE) -C interbase smart
-interbase_release:
- $(MAKE) -C interbase release
-interbase_units:
- $(MAKE) -C interbase units
-interbase_examples:
- $(MAKE) -C interbase examples
-interbase_shared:
- $(MAKE) -C interbase shared
-interbase_install:
- $(MAKE) -C interbase install
-interbase_sourceinstall:
- $(MAKE) -C interbase sourceinstall
-interbase_exampleinstall:
- $(MAKE) -C interbase exampleinstall
-interbase_distinstall:
- $(MAKE) -C interbase distinstall
-interbase_zipinstall:
- $(MAKE) -C interbase zipinstall
-interbase_zipsourceinstall:
- $(MAKE) -C interbase zipsourceinstall
-interbase_zipexampleinstall:
- $(MAKE) -C interbase zipexampleinstall
-interbase_zipdistinstall:
- $(MAKE) -C interbase zipdistinstall
-interbase_clean:
- $(MAKE) -C interbase clean
-interbase_distclean:
- $(MAKE) -C interbase distclean
-interbase_cleanall:
- $(MAKE) -C interbase cleanall
-interbase_info:
- $(MAKE) -C interbase info
-interbase_makefiles:
- $(MAKE) -C interbase makefiles
-interbase:
-.PHONY: interbase_all interbase_debug interbase_smart interbase_release interbase_units interbase_examples interbase_shared interbase_install interbase_sourceinstall interbase_exampleinstall interbase_distinstall interbase_zipinstall interbase_zipsourceinstall interbase_zipexampleinstall interbase_zipdistinstall interbase_clean interbase_distclean interbase_cleanall interbase_info interbase_makefiles interbase
-all: $(addsuffix _all,$(TARGET_DIRS))
-debug: $(addsuffix _debug,$(TARGET_DIRS))
-smart: $(addsuffix _smart,$(TARGET_DIRS))
-release: $(addsuffix _release,$(TARGET_DIRS))
-units: $(addsuffix _units,$(TARGET_DIRS))
-examples: $(addsuffix _examples,$(TARGET_DIRS))
-shared: $(addsuffix _shared,$(TARGET_DIRS))
-install: fpc_install $(addsuffix _install,$(TARGET_DIRS))
-sourceinstall: fpc_sourceinstall
-exampleinstall: fpc_exampleinstall $(addsuffix _exampleinstall,$(TARGET_DIRS))
-distinstall: $(addsuffix _distinstall,$(TARGET_DIRS))
-zipinstall:
-zipsourceinstall:
-zipexampleinstall: $(addsuffix _zipexampleinstall,$(TARGET_DIRS))
-zipdistinstall: $(addsuffix _zipdistinstall,$(TARGET_DIRS))
-clean: $(addsuffix _clean,$(TARGET_DIRS))
-distclean: $(addsuffix _distclean,$(TARGET_DIRS))
-cleanall: $(addsuffix _cleanall,$(TARGET_DIRS))
-info: fpc_info
-makefiles: fpc_makefiles
-.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
-ifneq ($(wildcard fpcmake.loc),)
-include fpcmake.loc
-.NOTPARALLEL:
@@ -1,29 +0,0 @@
-# Makefile.fpc for unmaintained db-structures
-
-[package]
-main=fcl-db
-[target]
-dirs=ddg
-dirs_linux=mysql interbase
-dirs_freebsd=mysql interbase
-dirs_darwin=mysql interbase
-dirs_netbsd=mysql interbase
-dirs_openbsd=mysql interbase
-dirs_win32=mysql interbase
-dirs_wince=interbase
-[compiler]
-options=-S2
-[install]
-fpcpackage=y
-[default]
-fpcdir=../../../..
-[rules]
@@ -1,19 +0,0 @@
-Here you can find some unmaintained database-units. They will be
-removed from fpc in the near future, so please do not use this
-units in new projects.
-The interbase, odbc and mysql components in here are replaced
-by the sqldb package.
-The sqlitedataset unit is replaced by the sqliteds units.
-The ddg units were only made to test the DB main classes, since
-there was no good TDataset descendents to test with. At this
-moment there are enough descendents to test with, which makes
-these units obsolete.
-Note that odbc and sqlite aren't even in the makefile, since
-they won't compile.
-Joost van der Sluis, [email protected], feb 2006
@@ -1,1980 +0,0 @@
-override DEFAULT_FPCDIR=../../../../..
-override TARGET_UNITS+=ddg_rec ddg_ds
-override REQUIRE_PACKAGES=rtl
-ifdef REQUIRE_PACKAGES_RTL
-PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_RTL),)
-ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
-UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
-UNITDIR_RTL=$(PACKAGEDIR_RTL)
-$(PACKAGEDIR_RTL)/$(FPCMADE):
- $(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE)
-PACKAGEDIR_RTL=
-UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_RTL),)
-UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
-UNITDIR_RTL=
-ifdef UNITDIR_RTL
-override COMPILER_UNITDIR+=$(UNITDIR_RTL)
-.PHONY: fpc_units
-ifneq ($(TARGET_UNITS),)
-override ALLTARGET+=fpc_units
-override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
-override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
-override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
-override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
-fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
-.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared
-$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
- @$(ECHOREDIR) Compiled > $(FPCMADE)
-fpc_all: $(FPCMADE)
-fpc_smart:
- $(MAKE) all LINKSMART=1 CREATESMART=1
-fpc_debug:
- $(MAKE) all DEBUG=1
-fpc_release:
- $(MAKE) all RELEASE=1
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
-$(COMPILER_UNITTARGETDIR):
- $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
-$(COMPILER_TARGETDIR):
- $(MKDIRTREE) $(COMPILER_TARGETDIR)
-%$(PPUEXT): %.pp
- $(COMPILER) $<
- $(EXECPPAS)
-%$(PPUEXT): %.pas
-%$(EXEEXT): %.pp
-%$(EXEEXT): %.pas
-%$(EXEEXT): %.lpr
-%$(EXEEXT): %.dpr
-%.res: %.rc
- windres -i $< -o $@
-vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
-vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
-.PHONY: fpc_shared
-override INSTALLTARGET+=fpc_shared_install
-ifndef SHARED_LIBVERSION
-SHARED_LIBVERSION=$(FPC_VERSION)
-ifndef SHARED_LIBNAME
-SHARED_LIBNAME=$(PACKAGE_NAME)
-ifndef SHARED_FULLNAME
-SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT)
-ifndef SHARED_LIBUNITS
-SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS)
-override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS))
-fpc_shared:
-ifdef HASSHAREDLIB
- $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1
-ifneq ($(SHARED_BUILD),n)
- $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR)
- @$(ECHO) Shared Libraries not supported
-fpc_shared_install:
-ifneq ($(SHARED_LIBUNITS),)
-ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),)
- $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR)
-all: fpc_all
-debug: fpc_debug
-smart: fpc_smart
-release: fpc_release
-units: fpc_units
-examples:
-shared: fpc_shared
-install: fpc_install
-exampleinstall: fpc_exampleinstall
-distinstall:
-zipexampleinstall:
-zipdistinstall:
-clean: fpc_clean
-distclean: fpc_distclean
-cleanall: fpc_cleanall
@@ -1,22 +0,0 @@
-# Makefile.fpc for TDataSet Tests
-units=ddg_rec ddg_ds
-fpcdir=../../../../..
@@ -1,65 +0,0 @@
-{
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by Michael Van Canneyt, member of the
- Free Pascal development team
- Creates a flat datafile for use with testds.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
-program createds;
-{$mode delphi}
-uses ddg_rec,sysutils;
-Type IndexFile = File Of Longint;
-Var F : TDDGDataFile;
- I : Integer;
- S : String;
- L : IndexFile;
- TableName : String;
- IndexName : String;
- ARec : TDDGData;
-begin
- If ParamCount<>1 then
- begin
- Writeln('Usage: createds tablename');
- Halt(1);
- end;
- TableName:=ChangeFileExt(paramstr(1),'.ddg');
- IndexName:=ChangeFileExt(TableName,'.ddx');
- Assign(F,TableName);
- Rewrite(F);
- For I:=1 to 100 do
- S:=Format('This is person %d.',[i]);
- With Arec Do
- Name:=S;
- height:=I*0.001;
- LongField:=i*4;
- ShoeSize:=I;
- WordField:=i*2;
- DateTimeField:=Now;
- TimeField:=Time;
- DateField:=Date;
- Even:=(I mod 2) = 0
- Write(F,ARec);
- Close(F);
- Assign(L,IndexName);
- Rewrite(L);
- For I:=0 to 100-1 do
- Write(L,I);
- Close(L);
-end.
@@ -1,522 +0,0 @@
-unit DDG_DS;
-{$define dsdebug}
-interface
-uses Db, Classes, DDG_Rec;
-type
- PInteger = ^Integer;
- // Bookmark information record to support TDataset bookmarks:
- PDDGBookmarkInfo = ^TDDGBookmarkInfo;
- TDDGBookmarkInfo = record
- BookmarkData: Integer;
- BookmarkFlag: TBookmarkFlag;
- // List used to maintain access to file of record:
- TIndexList = class(TList)
- public
- procedure LoadFromFile(const FileName: string); virtual;
- procedure LoadFromStream(Stream: TStream); virtual;
- procedure SaveToFile(const FileName: string); virtual;
- procedure SaveToStream(Stream: TStream); virtual;
- // Specialized DDG TDataset descendant for our "table" data:
- TDDGDataSet = class(TDataSet)
- private
- function GetDataFileSize: Integer;
- FDataFile: TDDGDataFile;
- FIdxName: string;
- FIndexList: TIndexList;
- FTableName: string;
- FRecordPos: Integer;
- FRecordSize: Integer;
- FBufferSize: Integer;
- procedure SetTableName(const Value: string);
- protected
- { Mandatory overrides }
- // Record buffer methods:
- function AllocRecordBuffer: PChar; override;
- procedure FreeRecordBuffer(var Buffer: PChar); override;
- procedure InternalInitRecord(Buffer: PChar); override;
- function GetRecord(Buffer: PChar; GetMode: TGetMode;
- DoCheck: Boolean): TGetResult; override;
- function GetRecordSize: Word; override;
- procedure SetFieldData(Field: TField; Buffer: Pointer); override;
- // Bookmark methods:
- procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
- function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
- procedure InternalGotoBookmark(ABookmark: Pointer); override;
- procedure InternalSetToRecord(Buffer: PChar); override;
- procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
- procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
- // Navigational methods:
- procedure InternalFirst; override;
- procedure InternalLast; override;
- // Editing methods:
- procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
- procedure InternalDelete; override;
- procedure InternalPost; override;
- // Misc methods:
- procedure InternalClose; override;
- procedure InternalInitFieldDefs; override;
- procedure InternalOpen; override;
- function IsCursorOpen: Boolean; override;
- { Optional overrides }
- function GetRecordCount: Integer; override;
- function GetRecNo: Integer; override;
- procedure SetRecNo(Value: Integer); override;
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
- // Additional procedures
- procedure EmptyTable;
- published
- property Active;
- property TableName: string read FTableName write SetTableName;
- property BeforeOpen;
- property AfterOpen;
- property BeforeClose;
- property AfterClose;
- property BeforeInsert;
- property AfterInsert;
- property BeforeEdit;
- property AfterEdit;
- property BeforePost;
- property AfterPost;
- property BeforeCancel;
- property AfterCancel;
- property BeforeDelete;
- property AfterDelete;
- property BeforeScroll;
- property AfterScroll;
- property OnDeleteError;
- property OnEditError;
- // Additional Properties
- property DataFileSize: Integer read GetDataFileSize;
-implementation
-uses SysUtils;
-const
- feDDGTable = '.ddg';
- feDDGIndex = '.ddx';
- // note that file is not being locked!
-{ TIndexList }
-procedure TIndexList.LoadFromFile(const FileName: string);
-var
- F: TFileStream;
- F := TFileStream.Create(FileName, fmOpenRead);
- try
- LoadFromStream(F);
- finally
- F.Free;
-end;
-procedure TIndexList.LoadFromStream(Stream: TStream);
- Value: PtrInt;
- while Stream.Position < Stream.Size do
- Stream.Read(Value, SizeOf(Value));
- Add(Pointer(Value));
-procedure TIndexList.SaveToFile(const FileName: string);
- F := TFileStream.Create(FileName, fmCreate);
- SaveToStream(F);
-procedure TIndexList.SaveToStream(Stream: TStream);
- i: Integer;
- for i := 0 to Count - 1 do
- Value := PtrInt(Items[i]);
- Stream.Write(Value, SizeOf(Value));
-{ TDDGDataSet }
-constructor TDDGDataSet.Create(AOwner: TComponent);
- FIndexList := TIndexList.Create;
- FRecordSize := SizeOf(TDDGData);
- FBufferSize := FRecordSize + SizeOf(TDDGBookmarkInfo);
- inherited Create(AOwner);
-destructor TDDGDataSet.Destroy;
- inherited Destroy;
- FIndexList.Free;
-function TDDGDataSet.AllocRecordBuffer: PChar;
- Result := AllocMem(FBufferSize);
-procedure TDDGDataSet.FreeRecordBuffer(var Buffer: PChar);
- FreeMem(Buffer);
-procedure TDDGDataSet.InternalInitRecord(Buffer: PChar);
- FillChar(Buffer^, FBufferSize, 0);
-function TDDGDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
- DoCheck: Boolean): TGetResult;
- IndexPos: Integer;
- if FIndexList.Count < 1 then
- Result := grEOF
- else begin
- Result := grOk;
- case GetMode of
- gmPrior:
- if FRecordPos <= 0 then
- Result := grBOF;
- FRecordPos := -1;
- end
- else
- Dec(FRecordPos);
- gmCurrent:
- if (FRecordPos < 0) or (FRecordPos >= RecordCount) then
- Result := grError;
- gmNext:
- if FRecordPos >= RecordCount-1 then
- Inc(FRecordPos);
- if Result = grOk then
- IndexPos := Integer(FIndexList[FRecordPos]);
- Seek(FDataFile, IndexPos);
- BlockRead(FDataFile, PDDGData(Buffer)^, 1);
- with PDDGBookmarkInfo(Buffer + FRecordSize)^ do
- BookmarkData := FRecordPos;
- BookmarkFlag := bfCurrent;
- else if (Result = grError) and DoCheck then
- DatabaseError('No records');
-function TDDGDataSet.GetRecordSize: Word;
- Result := FRecordSize;
-function TDDGDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
- Result := True;
- case Field.Index of
- 0:
- Move(ActiveBuffer^, Buffer^, Field.Size);
- Result := PChar(Buffer)^ <> #0;
- 1: Move(PDDGData(ActiveBuffer)^.Height, Buffer^, Field.DataSize);
- 2: Move(PDDGData(ActiveBuffer)^.LongField, Buffer^, Field.DataSize);
- 3: Move(PDDGData(ActiveBuffer)^.ShoeSize, Buffer^, Field.DataSize);
- 4: Move(PDDGData(ActiveBuffer)^.WordField, Buffer^, Field.DataSize);
- 5: Move(PDDGData(ActiveBuffer)^.DateTimeField, Buffer^, Field.DataSize);
- 6: Move(PDDGData(ActiveBuffer)^.TimeField, Buffer^, Field.DataSize);
- 7: Move(PDDGData(ActiveBuffer)^.DateField, Buffer^, Field.DataSize);
- 8: Move(PDDGData(ActiveBuffer)^.Even, Buffer^, Field.DataSize);
-procedure TDDGDataSet.SetFieldData(Field: TField; Buffer: Pointer);
- 0: Move(Buffer^, ActiveBuffer^, Field.Size);
- 1: Move(Buffer^, PDDGData(ActiveBuffer)^.Height, Field.DataSize);
- 2: Move(Buffer^, PDDGData(ActiveBuffer)^.LongField, Field.DataSize);
- 3: Move(Buffer^, PDDGData(ActiveBuffer)^.ShoeSize, Field.DataSize);
- 4: Move(Buffer^, PDDGData(ActiveBuffer)^.WordField, Field.DataSize);
- 5: Move(Buffer^, PDDGData(ActiveBuffer)^.DateTimeField, Field.DataSize);
- 6: Move(Buffer^, PDDGData(ActiveBuffer)^.TimeField, Field.DataSize);
- 7: Move(Buffer^, PDDGData(ActiveBuffer)^.DateField, Field.DataSize);
- 8: Move(Buffer^, PDDGData(ActiveBuffer)^.Even, Field.DataSize);
- DataEvent(deFieldChange, Ptrint(Field));
-procedure TDDGDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
- PInteger(Data)^ := PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkData;
-function TDDGDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
- Result := PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag;
-procedure TDDGDataSet.InternalGotoBookmark(ABookmark: Pointer);
- FRecordPos := PInteger(ABookmark)^;
- Writeln ('Bookmark : Setting record position to : ',FrecordPos);
-procedure TDDGDataSet.InternalSetToRecord(Buffer: PChar);
- // bookmark value is the same as an offset into the file
- FRecordPos := PDDGBookmarkInfo(Buffer + FRecordSize)^.Bookmarkdata;
-procedure TDDGDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
- PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
-procedure TDDGDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
- PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag := Value;
-procedure TDDGDataSet.InternalFirst;
-procedure TDDGDataSet.InternalInitFieldDefs;
- // create FieldDefs which map to each field in the data record
- FieldDefs.Clear;
- TFieldDef.Create(FieldDefs, 'Name', ftString, SizeOf(TNameStr), False, 1);
- TFieldDef.Create(FieldDefs, 'Height', ftFloat, 0, False, 2);
- TFieldDef.Create(FieldDefs, 'LongField',ftInteger, 0, False, 3);
- TFieldDef.Create(FieldDefs, 'ShoeSize', ftSmallint, 0, False, 4);
- TFieldDef.Create(FieldDefs, 'WordField', ftword, 0, false, 5);
- TFieldDef.Create(FieldDefs, 'DateTimeField', ftDateTime, 0, false, 6);
- TFieldDef.Create(FieldDefs, 'TimeField',ftTime, 0, false, 7);
- TFieldDef.Create(FieldDefs, 'DateField',ftDate, 0, false, 8);
- TFieldDef.Create(FieldDefs, 'Booleanfield',ftboolean, 0, False, 9);
-procedure TDDGDataSet.InternalLast;
- FRecordPos := FIndexList.Count;
-procedure TDDGDataSet.InternalClose;
- if FileRec(FDataFile).Mode <> 0 then
- CloseFile(FDataFile);
- FIndexList.SaveToFile(FIdxName);
- FIndexList.Clear;
- if DefaultFields then
- DestroyFields;
- FillChar(FDataFile, SizeOf(FDataFile), 0);
-procedure TDDGDataSet.InternalDelete;
- FIndexList.Delete(FRecordPos);
- if FRecordPos >= FIndexList.Count then Dec(FRecordPos);
-procedure TDDGDataSet.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
- RecPos: Integer;
- Seek(FDataFile, FileSize(FDataFile));
- BlockWrite(FDataFile, PDDGData(Buffer)^, 1);
- if DoAppend then
- FIndexList.Add(Pointer(PtrInt(FileSize(FDataFile) - 1)));
- InternalLast;
- if FRecordPos = -1 then RecPos := 0
- else RecPos := FRecordPos;
- FIndexList.Insert(RecPos, Pointer(PtrInt(FileSize(FDataFile) - 1)));
-procedure TDDGDataSet.InternalOpen;
- HFile: THandle;
- // make sure table and index files exist
- FIdxName := ChangeFileExt(FTableName, feDDGIndex);
- if not (FileExists(FTableName) and FileExists(FIdxName)) then
- {
- if MessageDlg('Table or index file not found. Create new table?',
- mtConfirmation, [mbYes, mbNo], 0) = mrYes then
- HFile := FileCreate(FTableName);
- if HFile = -1 then
- DatabaseError('Error creating table file');
- FileClose(HFile);
- HFile := FileCreate(FIdxName);
- DatabaseError('Error creating index file');
- }
- DatabaseError('Could not open table');
- // open data file
- FileMode := fmOpenReadWrite;
- Writeln ('OPening data file');
- AssignFile(FDataFile, FTableName);
- Reset(FDataFile);
- writeln ('Loading index file');
- FIndexList.LoadFromFile(FIdxName); // initialize index TList from file
- FRecordPos := -1; // initial record pos before BOF
- BookmarkSize := SizeOf(Integer); // initialize bookmark size for VCL
- InternalInitFieldDefs; // initialize FieldDef objects
- // Create TField components when no persistent fields have been created
- {$ifdef dsdebug}
- writeln ('Creating Fields');
- {$endif}
- if DefaultFields then CreateFields;
- writeln ('Binding Fields');
- BindFields(True); // bind FieldDefs to actual data
- except
- Writeln ('Caught Exception !!');
- raise;
- Writeln ('End of internalopen');
-procedure TDDGDataSet.InternalPost;
- RecPos, InsPos: PtrInt;
- Writeln ('Starting internal post.');
- if FRecordPos = -1 then
- RecPos := 0
- if State = dsEdit then RecPos := Integer(FIndexList[FRecordPos])
- else RecPos := FileSize(FDataFile);
- Seek(FDataFile, RecPos);
- Writeln ('Writing record to disk.');
- BlockWrite(FDataFile, PDDGData(ActiveBuffer)^, 1);
- if State <> dsEdit then
- if FRecordPos = -1 then InsPos := 0
- else InsPos := FRecordPos;
- FIndexList.Insert(InsPos, Pointer(RecPos));
- Writeln ('Writing index to disk.');
-function TDDGDataSet.IsCursorOpen: Boolean;
- Result := FileRec(FDataFile).Mode <> 0;
-function TDDGDataSet.GetRecordCount: Integer;
- Result := FIndexList.Count;
-function TDDGDataSet.GetRecNo: Integer;
- UpdateCursorPos;
- if (FRecordPos = -1) and (RecordCount > 0) then
- Result := 1
- Result := FRecordPos + 1;
-procedure TDDGDataSet.SetRecNo(Value: Integer);
- if (Value >= 0) and (Value <= FIndexList.Count-1) then
- FRecordPos := Value - 1;
- Resync([]);
-procedure TDDGDataSet.SetTableName(const Value: string);
- CheckInactive;
- FTableName := Value;
- if ExtractFileExt(FTableName) = '' then
- FTableName := FTableName + feDDGTable;
-function TDDGDataSet.GetDataFileSize: Integer;
- Result := FileSize(FDataFile);
-procedure TDDGDataSet.EmptyTable;
- Close;
- DeleteFile(FTableName);
- DeleteFile(FIdxName);
- Open;
@@ -1,32 +0,0 @@
-unit DDG_Rec;
-uses sysutils;
- // arbitary-length array of char used for name field
- TNameStr = array[0..31] of char;
- // this record info represents the "table" structure:
- PDDGData = ^TDDGData;
- TDDGData = record
- Name: TNameStr;
- Height: Extended;
- LongField : Longint;
- ShoeSize: SmallInt;
- WordField : Word;
- DatetimeField : TDateTime;
- TimeField : TDateTime;
- DateField : TDateTime;
- Even : Boolean;
- // Pascal file of record which holds "table" data:
- TDDGDataFile = file of TDDGData;
@@ -1,20 +0,0 @@
-{$mode objfpc}
-{$H+}
-program fpmake;
-uses fpmkunit;
-Var
- T : TTarget;
- ChangeDir('../..');
- With Installer do
- {$i ../../fclmake.inc}
- {$i fpmake.inc}
- EndPackage;
- Run;
@@ -1,177 +0,0 @@
- Tests the TDDGDataset component.
-program testds;
-uses db,ddg_ds,sysutils;
-Procedure Log(Const Msg : String);
- Writeln(Msg);
-Procedure DumpFieldDef(F : TfieldDef);
- With F do
- Writeln ('Name : ',Name);
- Writeln ('FieldNo : ',FieldNo);
- Writeln ('Size : ',Size);
- Writeln ('FieldClass : ',FieldClass.ClassName);
- Writeln ('Required : ',required);
- Writeln ('Precision : ',Precision);
- Writeln ('DataType : ',FieldTypeNames[DataType]);
- Writeln ('InternalCalcField : ',Internalcalcfield);
-Procedure DumpField(F : Tfield);
- writeln ('-------------------------------------');
- Writeln ('FieldName : ',FieldName);
- Writeln ('Index : ',Index);
- Writeln ('DataSize : ',DataSize);
- Writeln ('Class : ',ClassName);
- Writeln ('ReadOnly : ',ReadOnly);
- Writeln ('Visible : ',Visible);
-Procedure DumpFieldData (F : TField);
- With F Do
- Writeln ('Field : ',FieldName);
- Writeln ('Data type : ',FieldTypeNames[DataType]);
- Writeln ('As String : ',Asstring);
- Case Datatype of
- ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
- ftBoolean : Writeln ('As Boolean : ',AsBoolean);
- ftFloat : Writeln ('As Float : ',AsFloat);
- ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
- Data : TDDGdataset;
- I,Count : longint;
- Bookie : TBookMarkStr;
-Procedure ScrollForward;
- Writeln ('Browsing Forward:');
- Writeln ('------------------');
- With Data do
- While NOT EOF do
- Writeln ('================================================');
- For I:=0 to FieldCount-1 do
- DumpFieldData(Fields[I]);
- Next;
-Procedure ScrollBackWard;
- Writeln ('Browsing Backward:');
- Writeln ('-------------------');
- While NOT BOF do
- Prior;
- if paramcount<>1 then
- Writeln ('Usage : testds tablename');
- Log ('Creating Dataset');
- Data:=TDDGDataset.Create(Nil);
- Log('Setting Tablename');
- TableName:=Paramstr(1);
- Log('Opening Dataset');
- Log('Dumping fielddefs : ');
- Writeln ('Fielddefs count : ',FieldDefs.Count);
- For I:=0 to FieldDefs.Count-1 do
- DumpFieldDef(FieldDefs.Items[i]);
- Writeln ('Fields count : ',FieldCount);
- DumpField(Fields[i]);
- ScrollForward;
- ScrollBackWard;
- Writeln ('Going to last :');
- writeln ('---------------');
- Last;
- Writeln ('Going to first:');
- First;
- Count:=0;
- Inc(Count);
- If Count=50 then
- Writeln ('Setting bookmark on record');
- Bookie:=Bookmark;
- Writeln ('Got data : "',Bookie,'"');
- Writeln ('Jumping to bookmark',Bookie);
- BookMark:=Bookie;
- Writeln ('Dumping Record : ');
- Writeln ('Dumping Next Record : ');
- Writeln ('Dumping Previous Record : ');
- Log('Closing Dataset');
- Log('End.');
- Free;
@@ -1,235 +0,0 @@
-procedure DumpFields (DS : TDataset);
-Var I : longint;
- With DS do
- Writeln('Dumping fields');
- DumpFieldData(Fields[i]);
- Writeln ('Doing append');
- writeln ('------------');
- Append;
- FieldByName('Name').AsString:='AppendName';
- FieldByName('Height').AsFloat:=9.99E9;
- FieldByName('LongField').AsLongInt:=999;
- FieldByName('ShoeSize').AsLongInt:=999;
- FieldByName('WordField').AsLongInt:=999;
- FieldByName('BooleanField').AsBoolean:=False;
- FieldByName('DateTimeField').AsDateTime:=Now;
- FieldByName('DateField').AsDateTime:=Date;
- FieldByName('TimeField').AsDateTime:=Time;
- Writeln ('End of append, going to post');
- Post;
- DumpFields(Data);
- Writeln ('Doing Last');
- Writeln ('----------');
- Writeln ('Doing Prior');
- Writeln ('Doing Insert at position 8');
- writeln ('--------------------------');
- first;
- for I:=1 to 7 do
- Insert;
- FieldByName('Name').AsString:='Insertname';
- FieldByName('Height').AsFloat:=8.99E8;
- FieldByName('LongField').AsLongInt:=888;
- FieldByName('ShoeSize').AsLongInt:=888;
- FieldByName('WordField').AsLongInt:=888;
- FieldByName('BooleanField').AsBoolean:=True;
- Writeln ('Doing field dump');
- writeln ('----------------');
- Writeln ('-----------');
- Writeln ('Doing Next');
- Writeln ('Doing Edit at position 5');
- writeln ('-------------------------');
- for I:=1 to 4 do
- Edit;
- FieldByName('Name').AsString:='Editname';
- FieldByName('Height').AsFloat:=3.33E3;
- FieldByName('LongField').AsLongInt:=333;
- FieldByName('ShoeSize').AsLongInt:=333;
- FieldByName('WordField').AsLongInt:=333;
- Writeln ('Closing.');
@@ -1,2 +0,0 @@
- * TDateTime field interpretation
- * Some problems with TIBDataset.Close (fields)
@@ -1,2425 +0,0 @@
-override TARGET_UNITS+=interbase
-override TARGET_EXAMPLES+=testib
-override CLEAN_UNITS+=ibase40 ibase60
-override REQUIRE_PACKAGES=rtl ibase
-.PHONY: fpc_examples
-ifneq ($(TARGET_EXAMPLES),)
-HASEXAMPLES=1
-override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMPLES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .lpr,$(TARGET_EXAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))
-override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))
-override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES)))
-override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
-override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))
-ifneq ($(TARGET_EXAMPLEDIRS),)
-fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIRS))
-examples: fpc_examples
@@ -1,28 +0,0 @@
-# Makefile.fpc for interbase FCL db units
-units=interbase
-examples=testib
-[clean]
-units=ibase40 ibase60
-[require]
-packages=ibase
@@ -1,67 +0,0 @@
- Hello again
-with new version of Interbase objects suite
-slightly changes the work with it. Main change
-is TIBTransaction object, which overtake transaction
-handling from TIBDatabase. TIBDataset no longer exists,
-instead of it is TIBQuery now. Work with it is (I think)
-shown in testib.pp program.
-TIBTransaction has several methods for committing and
-rollback of changes made to database.
- Commit, Rollback : classic action taken, both methods
- ENDS transaction.
- CommitRetaining, RollbackRetaining : these methods
- both do as same as Commit or Rollback, but environment
- of transaction remains, so you don't need start new
- transaction. This can be of use for frequent changes
- to database, because it's faster than classic
- Commit|Rollback & StartTransaction.
-In short:
- * Create TIBDatabase
- * Create TIBTransaction
- * Assign transaction to database
- * Create TIBQuery
- * Execute query
- * Commit or rollback transaction, in short, end transaction
- * Close TIBDatabase
-Compiling:
- Simply type 'make' for building interbase unit, if you wanna
-test program type 'make examples'. For successfull compiling
-you must have Interbase server installed, or you must have
-libgds.so.* in ldpath. If linker shows errors like:
-/usr/lib/libgds.so: undefined reference to `dlclose'
-/usr/lib/libgds.so: undefined reference to `dlopen'
-/usr/lib/libgds.so: undefined reference to `crypt'
-/usr/lib/libgds.so: undefined reference to `dlsym'
-testib.pp(92,1) Warning: Error while linking
-you must to program source add compiler directives
-{$ifndef BSD} // BSD has libdl in libc
- {$linklib dl}
-{$endif}
-{$linklib crypt}
-and all should be OK. For running testib you must have
-testing database created. To create it, edit mkdb script,
-set variable ISQL to full path to isql program (it is
-set to /opt/interbase/bin/isql by default, which will work
-on most systems) and run by typing 'sh mkdb'.
-This units was built and tested on Linux, and I don't
-know, if you can build it on Win32 or Dos platform.
-Anyway, if you want to use it under windoze, you can
-port it ;)
-Volunteers, testers, suggestions etc. are always welcome,
-mailto address below
-Pavel Stingl
[email protected]
@@ -1,18 +0,0 @@
-{ Make DB directory and all subdirectories }
-{ FULLDB will be defined if included from db directory }
-{ FULLFCL will be defined if included from main FCL directory }
-{ Interbase directory }
-Targets.ResetDefaults;
-Targets.DefaultDir:='db/interbase';
-Targets.DefaultCPU:=[i386];
-Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,linux];
-T:=Targets.AddUnit('interbase');
-T:=Targets.AddExampleUnit('testib');
-if Defaults.OS in Targets.DefaultOS then
- CleanFiles.add('ibas40.o');
- CleanFiles.add('ibas40.ppu');
- CleanFiles.add('ibase60.o');
- CleanFiles.add('ibase60.ppu');
@@ -1,1264 +0,0 @@
- Copyright (c) 2000 by Pavel Stingl
- Interbase database & dataset
-unit Interbase;
-{$M+} // ### remove this!!!
-uses SysUtils, Classes, IBase60, DB;
- PInteger = ^integer;
- PSmallInt= ^smallint;
- TIBDatabase = class;
- TIBTransaction = class;
- TIBQuery = class;
- TIBStoredProc = class;
- EInterBaseError = class(Exception);
-{ TIBDatabase }
- TIBDatabase = class (TDatabase)
- FIBDatabaseHandle : pointer;
- FPassword : string;
- FStatus : array [0..19] of ISC_STATUS;
- FTransaction : TIBTransaction;
- FUserName : string;
- FCharSet : string;
- FDialect : integer;
- FRole : String;
- procedure SetDBDialect;
- procedure SetTransaction(Value : TIBTransaction);
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- function GetHandle : pointer; virtual;
- { This procedure makes connection to Interbase server internally.
- Is visible only by descendants, in application programming
- will be invisible. Connection you must establish by setting
- @link(Connected) property to true, or by call of Open method.
- procedure DoInternalConnect; override;
- { This procedure disconnects object from IB server internally.
- will be invisible. Disconnection you must make by setting
- @link(Connected) property to false, or by call of Close method.
- procedure DoInternalDisconnect; override;
- procedure StartTransaction; override;
- procedure EndTransaction; override;
- property Handle: Pointer read GetHandle;
- { On connect, TIBDatabase object retrieve SQL dialect of database file,
- and sets this property to responding value }
- property Dialect : integer read FDialect write FDialect;
- { Before firing Open method you must set @link(Password),@link(DatabaseName),
- @link(UserName) properties in order of successfull connect to database }
- property Password : string read FPassword write FPassword;
- { This property holds default transaction for database. You must assign it by hand
- now, default assignment becomes handy, in next release, with transaction
- handling and evidence }
- property Transaction : TIBTransaction read FTransaction write SetTransaction;
- property UserName : string read FUserName write FUserName;
- { The character set used in SQL statements }
- property CharSet : string read FCharSet write FCharSet;
- { Identifies, if connection to Interbase server is established, or not.
- Instead of calling Open, Close methods you can connect or disconnect
- by setting this property to true or false.
- property Connected;
- { This property holds database connect string. On local server it will be
- absolute path to the db file, if you wanna connect over network, this
- path looks like this: <server_name>:<path_on_server>, where server_name
- is absolute IP address, or name of server in DNS or hosts file, path_on_server
- is absolute path to the file again }
- Property Role : String read FRole write FRole;
- property DatabaseName;
- property KeepConnection;
- property LoginPrompt;
- property Params;
- property OnLogin;
-{ TIBTransaction }
- Interbase has two modes for commit and rollback transactions,
- the difference is simple. If you execute Commit or Rollback,
- current transaction ends, and you must create new one.
- If you, on other side, need only commit or rollback data
- without transaction closing, execute with CommitRetaining or
- RollbackRetaining. Transaction handle, environment etc. will be
- as same as before action. Possible values are : caNone, caCommit, caCommitRetaining, caRollback,
- caRollbackRetaining
- TCommitRollbackAction = (caNone, caCommit, caCommitRetaining, caRollback,
- caRollbackRetaining);
- TAccessMode = (amReadWrite, amReadOnly);
- TIsolationLevel = (ilConcurrent, ilConsistent, ilReadCommittedRecV,
- ilReadCommitted);
- TLockResolution = (lrWait, lrNoWait);
- TTableReservation = (trNone, trSharedLockRead, trSharedLockWrite,
- trProtectedLockRead, trProtectedLockWrite);
- TIBTransaction = class (TComponent)
- FTransactionHandle : pointer; // Transaction handle
- FAction : TCommitRollbackAction;
- FActive : boolean;
- FTPB : string; // Transaction parameter buffer
- FDatabase : TIBDatabase;
- FAccessMode : TAccessMode;
- FIsolationLevel : TIsolationLevel;
- FLockResolution : TLockResolution;
- FTableReservation : TTableReservation;
- procedure SetActive(Value : boolean);
- procedure SetTPB;
- { Commits all actions, which was made in transaction, and closes transaction}
- procedure Commit; virtual;
- { Commits all actions, closes transaction, and creates new one }
- procedure CommitRetaining; virtual;
- { Rollbacks all actions made in transaction, and closes transaction }
- procedure Rollback; virtual;
- { Rollbacks all actions made in transaction, closes trans. and creates new one }
- procedure RollbackRetaining; virtual;
- { Creates new transaction. If transaction is active, closes it and make new one.
- Action taken while closing responds to @link(Action) property settings }
- procedure StartTransaction;
- constructor Create(AOwner : TComponent); override;
- { Default action while closing transaction by setting
- @link(Active) property. For details see @link(TCommitRollbackAction)}
- property Action : TCommitRollbackAction read FAction write FAction;
- { Is set to true while transaction is active, false if not.
- If you set it manually to true, object executes
- @link(StartTransaction) method, if transaction is
- active, and you set Active to false, object executes
- one of @link(Commit), @link(CommitRetaining), @link(Rollback),
- @link(RollbackRetaining) methods, depending on @link(Action) property
- setting.
- property Active : boolean read FActive write SetActive;
- { Transaction must be assigned to some database session, for which purpose
- you must use this property}
- property Database : TIBDatabase read FDatabase write FDatabase;
- { These four properties will be used in next StartTransaction calls }
- property AccessMode: TAccessMode
- read FAccessMode write FAccessMode default amReadWrite;
- property IsolationLevel: TIsolationLevel
- read FIsolationLevel write FIsolationLevel default ilConcurrent;
- property LockResolution: TLockResolution
- read FLockResolution write FLockResolution default lrWait;
- property TableReservation: TTableReservation
- read FTableReservation write FTableReservation default trNone;
-{ TIBQuery }
- PIBBookmark = ^TIBBookmark;
- TIBBookmark = record
- BookmarkData : integer;
- BookmarkFlag : TBookmarkFlag;
- TStatementType = (stNone, stSelect, stInsert, stUpdate, stDelete,
- stDDL, stGetSegment, stPutSegment, stExecProcedure,
- stStartTrans, stCommit, stRollback, stSelectForUpd);
- TIBQuery = class (TDBDataset)
- FOpen : Boolean;
- FFieldFlag : array [0..1023] of IBase60.Short;
- FBufferSize : integer;
- FSQLDA : PXSQLDA;
- FSQLDAAllocated : integer;
- FStatement : pointer;
- FRecordCount : integer;
- FRecordSize : word;
- FCurrentRecord : integer;
- FSQL : TStrings;
- FIsEOF : boolean;
- FStatementType : TStatementType;
- FLoadingFieldDefs : boolean;
- procedure SetDatabase(Value : TIBDatabase);
- procedure AllocSQLDA(Count : integer);
- procedure AllocStatement;
- procedure FreeStatement;
- procedure PrepareStatement;
- procedure DescribeStatement;
- procedure SetUpSQLVars;
- procedure AllocFldBuffers;
- procedure FreeFldBuffers;
- procedure Fetch;
- function LoadBufferFromSQLDA(Buffer : PChar): TGetResult;
- procedure GetStatementType;
- procedure SetFieldSizes;
- procedure TranslateFldType(SQLType, SQLLen : integer; var LensSet : boolean;
- var TrType : TFieldType; var TrLen : word);
- procedure ExecuteImmediate;
- procedure ExecuteParams;
- procedure Execute;
- // conversion methods
- procedure GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
- procedure GetFloat(CurrBuff, Buffer : pointer; Field : TField);
- // abstract & virual methods of TDataset
- function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
- function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
- function GetRecordCount: integer; override;
- procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
- procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
- { This method is used for executing sql statements, which
- doesn't return any rows. (insert,delete,update, and DDL commands) }
- procedure ExecSQL; virtual;
- { Query must have transaction assigned. If transaction is not assigned, and database
- is, object looks, if database have default transaction, and assigns it }
- { Use this property to determine, which database session can query use }
- property Database : TIBDatabase read FDatabase write SetDatabase;
- { This property holds SQL command, which you want to execute }
- property SQL : TStrings read FSQL write FSQL;
- // Publish TDataset properties.
- property AutoCalcFields;
- property OnCalcFields;
- property OnFilterRecord;
- property OnNewRecord;
- property OnPostError;
-{ TIBStoredProc - not implemented - yet :-/}
- TIBStoredProc = class (TDataset)
- TTm = packed record
- tm_sec : longint;
- tm_min : longint;
- tm_hour : longint;
- tm_mday : longint;
- tm_mon : longint;
- tm_year : longint;
- tm_wday : longint;
- tm_yday : longint;
- tm_isdst : longint;
- __tm_gmtoff : longint;
- __tm_zone : Pchar;
-procedure CheckError(ProcName : string; Status : PISC_STATUS);
- buf : array [0..1024] of char;
- Msg : string;
- if ((Status[0] = 1) and (Status[1] <> 0)) then
- while isc_interprete(Buf, @Status) > 0 do
- Msg := Msg + #10' -' + StrPas(Buf);
- raise EInterBaseError.Create(ProcName + ': ' + Msg);
-procedure TIBDatabase.SetDBDialect;
- x : integer;
- Len : integer;
- Buffer : array [0..1] of byte;
- ResBuf : array [0..39] of byte;
- Buffer[0] := isc_info_db_sql_dialect;
- Buffer[1] := isc_info_end;
- if isc_database_info(@FStatus[0], @FIBDatabaseHandle, sizeof(Buffer),
- pchar(@Buffer[0]), SizeOf(ResBuf), pchar(@ResBuf)) <> 0 then
- CheckError('TIBDatabse.SetDBDialect', FStatus);
- x := 0;
- while x < 40 do
- case ResBuf[x] of
- isc_info_db_sql_dialect :
- Inc(x);
- Len := isc_vax_integer(pchar(@ResBuf[x]), 2);
- Inc(x, 2);
- FDialect := isc_vax_integer(pchar(@ResBuf[x]), Len);
- Inc(x, Len);
- isc_info_end : Break;
-procedure TIBDatabase.SetTransaction(Value : TIBTransaction);
- if Value <> FTransaction then
- if FTransaction <> nil then
- if FTransaction.Active then
- raise EInterBaseError.Create(
- 'Cannot assign transaction while old transaction active!');
- FTransaction.RemoveFreeNotification(Self);
- FTransaction := Value;
- FTransaction.Database := Self;
- FTransaction.FreeNotification(Self);
-function TIBDatabase.GetHandle: pointer;
- Result := FIBDatabaseHandle;
-procedure TIBDatabase.DoInternalConnect;
- DPB : string;
- if Connected then
- DPB := chr(isc_dpb_version1);
- if (FUserName <> '') then
- DPB := DPB + chr(isc_dpb_user_name) + chr(Length(FUserName)) + FUserName;
- if (FPassword <> '') then
- DPB := DPB + chr(isc_dpb_password) + chr(Length(FPassword)) + FPassword;
- if (FRole <> '') then
- DPB := DPB + chr(isc_dpb_sql_role_name) + chr(Length(FRole)) + FRole;
- if Length(CharSet) > 0 then
- DPB := DPB + Chr(isc_dpb_lc_ctype) + Chr(Length(CharSet)) + CharSet;
- if (DatabaseName = '') then
- raise EInterBaseError.Create('TIBDatabase.Open: Database connect string (DatabaseName) not filled in!');
- FIBDatabaseHandle := nil;
- if isc_attach_database(@FStatus[0], Length(DatabaseName), @DatabaseName[1], @FIBDatabaseHandle,
- Length(DPB), @DPB[1]) <> 0 then
- CheckError('TIBDatabase.Open', FStatus);
- SetDBDialect;
-procedure TIBDatabase.DoInternalDisconnect;
- if not Connected then
- Exit;
- isc_detach_database(@FStatus[0], @FIBDatabaseHandle);
- CheckError('TIBDatabase.Close', FStatus);
-procedure TIBDatabase.StartTransaction;
- if FTransaction = nil then
- raise EDatabaseError.Create('TIBDatabase.StartTransaction: Transaction not set');
- FTransaction.Active := True;
-procedure TIBDatabase.EndTransaction;
- raise EDatabaseError.Create('TIBDatabase.EndTransaction: Transaction not set');
- FTransaction.Active := False;
-destructor TIBDatabase.Destroy;
- FTransaction.Database := nil;
-procedure TIBDatabase.Notification(AComponent: TComponent;
- Operation: TOperation);
- inherited;
- if (AComponent = FTransaction) and (Operation = opRemove) then
- FTransaction := nil;
-procedure TIBTransaction.SetActive(Value : boolean);
- if FActive and (not Value) then
- Rollback
- else if (not FActive) and Value then
- StartTransaction;
-procedure TIBTransaction.SetTPB;
- FTPB := chr(isc_tpb_version3);
- case FAccessMode of
- amReadWrite : FTPB := FTPB + chr(isc_tpb_write);
- amReadOnly : FTPB := FTPB + chr(isc_tpb_read);
- case FIsolationLevel of
- ilConsistent : FTPB := FTPB + chr(isc_tpb_consistency);
- ilConcurrent : FTPB := FTPB + chr(isc_tpb_concurrency);
- ilReadCommittedRecV : FTPB := FTPB + chr(isc_tpb_read_committed) +
- chr(isc_tpb_rec_version);
- ilReadCommitted : FTPB := FTPB + chr(isc_tpb_read_committed) +
- chr(isc_tpb_no_rec_version);
- case FLockResolution of
- lrWait : FTPB := FTPB + chr(isc_tpb_wait);
- lrNoWait : FTPB := FTPB + chr(isc_tpb_nowait);
- case FTableReservation of
- trSharedLockRead : FTPB := FTPB + chr(isc_tpb_shared) +
- chr(isc_tpb_lock_read);
- trSharedLockWrite : FTPB := FTPB + chr(isc_tpb_shared) +
- chr(isc_tpb_lock_write);
- trProtectedLockRead : FTPB := FTPB + chr(isc_tpb_protected) +
- trProtectedLockWrite : FTPB := FTPB + chr(isc_tpb_protected) +
-function TIBTransaction.GetHandle: pointer;
- Result := FTransactionHandle;
-procedure TIBTransaction.Commit;
- if not FActive then Exit;
- if isc_commit_transaction(@FStatus[0], @FTransactionHandle) <> 0 then
- CheckError('TIBTransaction.Commit', FStatus)
- else FActive := False;
-procedure TIBTransaction.CommitRetaining;
- if isc_commit_retaining(@FStatus[0], @FTransactionHandle) <> 0 then
- CheckError('TIBTransaction.CommitRetaining', FStatus);
-procedure TIBTransaction.Rollback;
- if isc_rollback_transaction(@FStatus[0], @FTransactionHandle) <> 0 then
- CheckError('TIBTransaction.Rollback', FStatus)
-procedure TIBTransaction.RollbackRetaining;
- if isc_rollback_retaining(@FStatus[0], @FTransactionHandle) <> 0 then
- CheckError('TIBTransaction.RollbackRetaining', FStatus);
-procedure TIBTransaction.StartTransaction;
- DBHandle : pointer;
- if Active then Active := False;
- if FDatabase = nil then
- raise EInterBaseError.Create('TIBTransaction.StartTransaction: Database not assigned!');
- if not Database.Connected then
- Database.Open;
- DBHandle := Database.GetHandle;
- SetTPB;
- FTransactionHandle := nil;
- if isc_start_transaction(@FStatus[0], @FTransactionHandle, 1,
- [@DBHandle, Length(FTPB), @FTPB[1]]) <> 0 then
- CheckError('TIBTransaction.StartTransaction',FStatus)
- else FActive := True;
-constructor TIBTransaction.Create(AOwner : TComponent);
- FIsolationLevel := ilConcurrent;
-destructor TIBTransaction.Destroy;
- // This will also do a Rollback, if the transaction is currently active
- Active := False;
- if Database <> nil then
- Database.Transaction := nil;
- { For now, we could simply say here that TFieldDataPrefix = boolean.
- But making TFieldDataPrefix as record will be allow to very easy add
- similar things like "IsNull" in the future.
- Any information that has constant length, and should be
- specified separately for every field of every row can be added as
- another TFieldDataPrefix field. }
- TFieldDataPrefix = record
- IsNull: boolean;
- PFieldDataPrefix = ^TFieldDataPrefix;
-procedure TIBQuery.SetTransaction(Value : TIBTransaction);
- if (FTransaction <> Value) then
-procedure TIBQuery.SetDatabase(Value : TIBDatabase);
- if (FDatabase <> Value) then
- FDatabase := Value;
- if (FTransaction = nil) and (Assigned(FDatabase.Transaction)) then
- SetTransaction(FDatabase.Transaction);
-procedure TIBQuery.AllocSQLDA(Count : integer);
- if FSQLDAAllocated > 0 then
- FreeMem(FSQLDA);
- GetMem(FSQLDA, XSQLDA_Length(Count));
- { Zero out the memory block to avoid problems with exceptions within the
- constructor of this class. }
- FillChar(FSQLDA^, XSQLDA_Length(Count), 0);
- FSQLDAAllocated := Count;
- FSQLDA^.Version := sqlda_version1;
- FSQLDA^.SQLN := Count;
-procedure TIBQuery.AllocStatement;
- dh : pointer;
- if not FDatabase.Connected then
- FDatabase.Open;
- dh := FDatabase.GetHandle;
- if isc_dsql_allocate_statement(@FStatus[0], @dh, @FStatement) <> 0 then
- CheckError('TIBQuery.AllocStatement', FStatus);
-procedure TIBQuery.FreeStatement;
- if isc_dsql_free_statement(@FStatus[0], @FStatement, DSQL_Drop) <> 0 then
- CheckError('TIBQuery.FreeStatement', FStatus);
- FStatement := nil;
-procedure TIBQuery.PrepareStatement;
- Buf : string;
- tr : pointer;
- raise EDatabaseError.Create('TIBQuery.Execute: Transaction not set');
- if not FTransaction.Active then
- FTransaction.StartTransaction;
- tr := FTransaction.GetHandle;
- for x := 0 to FSQL.Count - 1 do
- Buf := Buf + FSQL[x] + ' ';
- if isc_dsql_prepare(@FStatus[0], @tr, @FStatement, 0, @Buf[1], Database.Dialect, nil) <> 0 then
- CheckError('TIBQuery.PrepareStatement', FStatus);
-procedure TIBQuery.DescribeStatement;
- if isc_dsql_describe(@FStatus[0], @FStatement, 1, FSQLDA) <> 0 then
- CheckError('TIBQuery.DescribeStatement', FStatus);
- if FSQLDA^.SQLD > FSQLDA^.SQLN then
- AllocSQLDA(FSQLDA^.SQLD);
-procedure TIBQuery.SetUpSQLVars;
- for x := 0 to FSQLDA^.SQLN - 1 do
- case FSQLDA^.SQLVar[x].SQLType of
- sql_varying + 1:
- FSQLDA^.SQLVar[x].SQLType := sql_varying;
- sql_text + 1 :
- FSQLDA^.SQLVar[x].SQLType := sql_text;
- sql_short, sql_short + 1, sql_long + 1:
- FSQLDA^.SQLVar[x].SQLType := sql_long;
- sql_float + 1 :
- FSQLDA^.SQLVar[x].SQLType := sql_float;
- sql_double + 1 :
- FSQLDA^.SQLVar[x].SQLType := sql_double;
- sql_blob + 1 :
- FSQLDA^.SQLVar[x].SQLType := sql_blob;
- sql_type_time + 1 :
- FSQLDA^.SQLVar[x].SQLType := sql_type_time;
- sql_timestamp + 1:
- FSQLDA^.SQLVar[x].SQLType := sql_timestamp;
-procedure TIBQuery.AllocFldBuffers;
- x : shortint;
- {$R-}
- for x := 0 to FSQLDA^.SQLD - 1 do
- FSQLDA^.SQLVar[x].SQLData := AllocMem(FSQLDA^.SQLVar[x].SQLLen);
- FSQLDA^.SQLVar[x].SQLInd := @FFieldFlag[x];
- {$R+}
-procedure TIBQuery.FreeFldBuffers;
- if FSQLDA^.SQLVar[x].SQLData <> nil then
- FreeMem(FSQLDA^.SQLVar[x].SQLData);
- FSQLDA^.SQLVar[x].SQLData := nil;
-procedure TIBQuery.Fetch;
- retcode : integer;
- if not (FStatementType in [stSelect]) then
- retcode := isc_dsql_fetch(@FStatus[0], @FStatement, 1, FSQLDA);
- if (retcode <> 0) and (retcode <> 100) then
- CheckError('TIBQuery.Fetch', FStatus);
- FIsEOF := (retcode = 100);
-function TIBQuery.LoadBufferFromSQLDA(Buffer : PChar): TGetResult;
- VarcharLen : word;
- Fetch;
- if FIsEOF then
- Result := grEOF;
- with FSQLDA^.SQLVar[x] do
- PFieldDataPrefix(Buffer)^.IsNull :=
- { If 1st bit of SQLType is not set then field *cannot* be null,
- and we shouldn't check SQLInd }
- ((SQLType and 1) <> 0) and (SQLInd^ = -1);
- Inc(Buffer, SizeOf(TFieldDataPrefix));
- if ((SQLType and not 1) = SQL_VARYING) then
- Move(SQLData^, VarcharLen, 2);
- Move((SQLData + 2)^, Buffer^, VarcharLen);
- PChar(Buffer + VarcharLen)^ := #0;
- else Move(SQLData^, Buffer^, SQLLen);
- Inc(Buffer, SQLLen);
- Result := grOK;
-procedure TIBQuery.GetStatementType;
- ResBuf : array [0..7] of char;
- FStatementType := stNone;
- x := isc_info_sql_stmt_type;
- if isc_dsql_sql_info(@FStatus[0], @FStatement, SizeOf(X),
- pchar(@x), SizeOf(ResBuf), @ResBuf[0]) <> 0 then
- CheckError('TIBQuery.GetStatementType', FStatus);
- if Ord(ResBuf[0]) = isc_info_sql_stmt_type then
- x := isc_vax_integer(@ResBuf[1], 2);
- FStatementType := TStatementType(isc_vax_integer(@ResBuf[3], x));
-procedure TIBQuery.SetFieldSizes;
- FRecordSize := 0;
- Inc(FRecordSize, FSQLDA^.SQLVar[x].SQLLen);
- Inc(FRecordSize, SizeOf(TFieldDataPrefix) * FSQLDA^.SQLD);
- FBufferSize := FRecordSize + SizeOf(TIBBookmark);
-procedure TIBQuery.TranslateFldType(SQLType, SQLLen : integer; var LensSet : boolean;
- LensSet := False;
- case (SQLType and not 1) of
- SQL_VARYING :
- LensSet := True;
- TrType := ftString;
- TrLen := SQLLen;
- SQL_TEXT :
- SQL_TYPE_DATE :
- TrType := ftDateTime;
- SQL_TYPE_TIME :
- SQL_TIMESTAMP :
- SQL_ARRAY :
- SQL_BLOB :
- SQL_SHORT :
- TrType := ftInteger;
- SQL_LONG :
- SQL_INT64 :
- {TrType := ftInt64};
- SQL_DOUBLE :
- TrType := ftFloat;
- SQL_FLOAT :
-procedure TIBQuery.ExecuteImmediate;
-procedure TIBQuery.ExecuteParams;
- //!! to be implemented
-procedure TIBQuery.Execute;
- if isc_dsql_execute(@FStatus[0], @tr, @FStatement, 1, nil) <> 0 then
- CheckError('TIBQuery.Execute', FStatus);
-procedure TIBQuery.GetDateTime(CurrBuff, Buffer : pointer; AType : integer);
- CTime : TTm; // C struct time
- STime : TSystemTime; // System time
- PTime : TDateTime; // Pascal time
- case (AType and not 1) of
- isc_decode_sql_date(PISC_DATE(CurrBuff), @CTime);
- isc_decode_sql_time(PISC_TIME(CurrBuff), @CTime);
- isc_decode_timestamp(PISC_TIMESTAMP(CurrBuff), @CTime);
- STime.Year := CTime.tm_year + 1900;
- STime.Month := CTime.tm_mon + 1;
- STime.Day := CTime.tm_mday;
- STime.Hour := CTime.tm_hour;
- STime.Minute := CTime.tm_min;
- STime.Second := CTime.tm_sec;
- STime.Millisecond := 0;
- PTime := SystemTimeToDateTime(STime);
- Move(PTime, Buffer^, SizeOf(PTime));
-procedure TIBQuery.GetFloat(CurrBuff, Buffer : pointer; Field : TField);
- Ext : extended;
- Dbl : double;
- Sin : single;
- case Field.Size of
- 4 :
- Move(CurrBuff^, Sin, 4);
- //Ext := Sin;
- Dbl := Sin;
- 8 :
- Move(CurrBuff^, Dbl, 8);
- //Ext := Dbl;
- 10:
- Move(CurrBuff^, Ext, 10);
- Dbl := Ext;
- //Move(Ext, Buffer^, 10);
- Move(Dbl, Buffer^, 8);
-function TIBQuery.AllocRecordBuffer: PChar;
-procedure TIBQuery.FreeRecordBuffer(var Buffer: PChar);
- if Assigned(@Buffer) then
-procedure TIBQuery.GetBookmarkData(Buffer: PChar; Data: Pointer);
- PInteger(Data)^ := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
-function TIBQuery.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
- Result := PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag;
-function TIBQuery.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
- x : longint;
- b : longint;
- CurrBuff : PChar;
- Result := False;
- CurrBuff := ActiveBuffer;
- if (Field.FieldName = FSQLDA^.SQLVar[x].AliasName) then
- Result := not PFieldDataPrefix(CurrBuff)^.IsNull;
- if Result and (Buffer <> nil) then
- Inc(CurrBuff, SizeOf(TFieldDataPrefix));
- case Field.DataType of
- ftInteger :
- b := 0;
- Move(b, Buffer^, 4);
- Move(CurrBuff^, Buffer^, Field.Size);
- ftDate, ftTime, ftDateTime:
- GetDateTime(CurrBuff, Buffer, FSQLDA^.SQLVar[x].SQLType);
- ftString :
- PChar(Buffer + Field.Size)^ := #0;
- ftFloat :
- GetFloat(CurrBuff, Buffer, Field);
- Break;
- else Inc(CurrBuff, FSQLDA^.SQLVar[x].SQLLen + SizeOf(TFieldDataPrefix));
-function TIBQuery.GetFieldData(Field: TField; Buffer: Pointer;
- NativeFormat: Boolean): Boolean;
- Result := GetFieldData(Field, Buffer);
-function TIBQuery.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
- if FStatementType <> stSelect then
- gmPrior :
- if FCurrentRecord <= 0 then
- FCurrentRecord := -1;
- else Dec(FCurrentRecord);
- gmCurrent :
- if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
- gmNext :
- if FCurrentRecord >= (RecordCount - 1) then
- Result := LoadBufferFromSQLDA(Buffer);
- if Result = grOK then
- Inc(FCurrentRecord);
- Inc(FRecordCount);
- else Inc(FCurrentRecord);
- with PIBBookmark(Buffer + FRecordSize)^ do
- BookmarkData := FCurrentRecord;
- else if (Result = grError) then
- DatabaseError('No record');
-function TIBQuery.GetRecordCount: integer;
- Result := FRecordCount;
-function TIBQuery.GetRecordSize: Word;
-procedure TIBQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
- // not implemented - sql dataset
-procedure TIBQuery.InternalClose;
- FreeFldBuffers;
- FreeStatement;
- FIsEOF := False;
- FBufferSize := 0;
- FRecordCount:= 0;
- FOpen:=False;
-procedure TIBQuery.InternalDelete;
-procedure TIBQuery.InternalFirst;
-procedure TIBQuery.InternalGotoBookmark(ABookmark: Pointer);
- FCurrentRecord := PInteger(ABookmark)^;
-procedure TIBQuery.InternalInitFieldDefs;
- lenset : boolean;
- TransLen : word;
- TransType : TFieldType;
- if FLoadingFieldDefs then
- FLoadingFieldDefs := True;
- TranslateFldType(FSQLDA^.SQLVar[x].SQLType, FSQLDA^.SQLVar[x].SQLLen, lenset,
- TransType, TransLen);
- TFieldDef.Create(FieldDefs, FSQLDA^.SQLVar[x].AliasName, TransType,
- TransLen, False, (x + 1));
- FLoadingFieldDefs := False;
-procedure TIBQuery.InternalInitRecord(Buffer: PChar);
- FillChar(Buffer^, FBufferSize, #0);
-procedure TIBQuery.InternalLast;
- FCurrentRecord := RecordCount;
-procedure TIBQuery.InternalOpen;
- AllocStatement;
- PrepareStatement;
- GetStatementType;
- if FStatementType in [stSelect] then
- DescribeStatement;
- AllocFldBuffers;
- Execute;
- FOpen:=True;
- InternalInitFieldDefs;
- CreateFields;
- SetFieldSizes;
- BindFields(True);
- else Execute;
- on E:Exception do
-procedure TIBQuery.InternalPost;
-procedure TIBQuery.InternalSetToRecord(Buffer: PChar);
- FCurrentRecord := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
-function TIBQuery.IsCursorOpen: Boolean;
- Result := FOpen;
-procedure TIBQuery.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
- PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
-procedure TIBQuery.SetBookmarkData(Buffer: PChar; Data: Pointer);
- PIBBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
-procedure TIBQuery.SetFieldData(Field: TField; Buffer: Pointer);
-procedure TIBQuery.SetFieldData(Field: TField; Buffer: Pointer;
- NativeFormat: Boolean);
- SetFieldData(Field, Buffer);
-// public part
-procedure TIBQuery.ExecSQL;
-constructor TIBQuery.Create(AOwner : TComponent);
- FSQL := TStringList.Create;
- AllocSQLDA(10);
-destructor TIBQuery.Destroy;
- if Active then Close;
- FSQL.Free;
-{ TIBStoredProc }
@@ -1,49 +0,0 @@
-#!/bin/sh
-# Script to create a table 'FPdev' and to fill it with data.
-# The script accepts an optional argument :
-# A database to connect to. (default 'testdb')
-# Collect the database
-DATABASE=test.gdb
-# Choose one of the following:
-# ISQL=isql
-ISQL=/opt/interbase/bin/isql
-# Don't edit after this.
-echo -n "Creating and filling table FPdev in database $DATABASE..."
-# >/dev/null 2>&1
-${ISQL} << EOF
-set sql dialect 3;
-CREATE DATABASE "$DATABASE";
-create table FPDEV (
-id INT NOT NULL,
-UserName varchar(50),
-InstEmail CHAR(50),
-PRIMARY KEY (id));
-insert into FPdev values ('1','Michael Van Canneyt','[email protected]');
-insert into FPdev values ('2','Florian Klaempfl','[email protected]');
-insert into FPdev values ('3','Carl-Eric Codere','[email protected]');
-insert into FPdev values ('4','Daniel Mantione','[email protected]');
-insert into FPdev values ('5','Pierre Muller','[email protected]');
-insert into FPdev values ('6','Jonas Maebe','[email protected]');
-insert into FPdev values ('7','Peter Vreman','[email protected]');
-insert into FPdev values ('8','Gerry Dubois','[email protected]');
-create table test (
-timestamp_fld timestamp,
-smallint_fld smallint,
-integer_fld integer,
-float_fld float,
-double_fld double precision,
-char_fld char(10),
-varchar_fld varchar(50));
-insert into test values ('12.1.2000 00:30',10,70000,12.5,20.5,'testchar','testvarchar');
-commit;
-EOF
-if [ ! $? = 0 ]; then
- echo "Failed."
- echo "Done."
-fi
-# Ready
@@ -1,92 +0,0 @@
- Interbase testing program
-program TestIB;
-{$ifdef unix}
- {$ifndef BSD} // BSD has libdl built in libc
-uses Interbase, SysUtils;
- Database : TIBDatabase;
- Trans : TIBTransaction;
- Query : TIBQuery;
- Database := TIBDatabase.Create(nil);
- Trans := TIBTransaction.Create(nil);
- Query := TIBQuery.Create(nil);
- Database.DatabaseName := 'test.gdb';
- Database.UserName := 'sysdba';
- Database.Password := 'masterkey';
- Database.Transaction := Trans;
- Trans.Action := caRollback;
- Trans.Active := True;
- Write('Opening database... Database.Connected = ');
- WriteLn(Database.Connected);
- // Assigning database to dataset
- Query.Database := Database;
- Query.SQL.Add('select * from fpdev');
- Query.Open;
- WriteLn;
- while not Query.EOF do
- for x := 0 to Query.FieldCount - 2 do
- Write(Query.Fields[x].AsString,',');
- WriteLn(Query.Fields[Query.FieldCount - 1].AsString);
- Query.Next;
- WriteLn('Trying to insert new record to table fpdev');
- Query.Close;
- Query.SQL.Clear;
- Query.SQL.Add('insert into fpdev values (''9'',''John Doe'',''[email protected]'')');
- Query.ExecSQL;
- Trans.CommitRetaining;
- WriteLn('Insert succeeded.');
- WriteLn(E.Message);
- WriteLn('Error when inserting record. Transaction rollback.');
- Trans.RollbackRetaining;
- Trans.Commit;
- Write('Closing database... Database.Connected = ');
- Database.Close;
@@ -1,2581 +0,0 @@
-override TARGET_UNITS+=mysqldb4 mysqldb3
-override TARGET_RSTS+=mysqldb
-override TARGET_EXAMPLES+=mtest
-override CLEAN_UNITS+=mysql mysql_com mysql_version
-override REQUIRE_PACKAGES=rtl mysql
-# Makefile.fpc for MySql FCL db units
-units=mysqldb4 mysqldb3
-rsts=mysqldb
-examples=mtest
-units=mysql mysql_com mysql_version
-packages=mysql
@@ -1,21 +0,0 @@
-Targets.DefaultDir:='db/mysql';
-Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,darwin,linux];
-T:=Targets.AddUnit('mysqldb4');
-T.ResourceStrings:=True;
-T:=Targets.AddUnit('mysqldb3');
-Targets.Addexampleunit('mtest');
- CleanFiles.add('mysql.o');
- CleanFiles.add('mysql.ppu');
- CleanFiles.add('mysql_com.o');
- CleanFiles.add('mysql_com.ppu');
- CleanFiles.add('mysql_version.o');
- CleanFiles.add('mysql_version.ppu');
@@ -1,198 +0,0 @@
- Copyright (c) 1999-2000 by the Free Pascal development team
- <What does this file>
-program mtest;
-uses db,sysutils, mysqldb4; // change to mysqldb3 if you are using version 3.
- Dbase : TMySQLDatabase;
- Data : TMysqldataset;
- if paramcount<>4 then
- Writeln ('Usage : mtest db user pwd sql');
- Log ('Creating Database');
- DBase:=TMySQLDatabase.Create(Nil);
- Try
- With DBase do
- Log('Setting database');
- DatabaseName:=Paramstr(1);
- Log('Setting user');
- UserName:=Paramstr(2);
- Log('Setting password');
- PassWord := Paramstr(3);
- Log('Connecting');
- Connected:=True;
- Data:=TMysqlDataset.Create(Nil);
- Log('Setting database property');
- Database:=DBase;
- Log('Setting SQL');
- SQL.text := Paramstr(4);
- If Count=recordCount div 2 then
- Finally
- Writeln('Freeing database');
- DBase.free;
@@ -1,924 +0,0 @@
-unit MySQLDB3;
-uses
- SysUtils, Classes, db, mysql3,mysql3_com;
- PMySQLDatasetBookmark = ^TMySQLDatasetBookmark;
- TMySQLDatasetBookmark = record
- Pinteger = ^Integer;
- TMySQLDatabase = class(TDatabase)
- Private
- FMYSQL: PMYSQL;
- FServerInfo: string;
- FHostInfo: string;
- function GetHostName: String;
- Function GetUserName : String;
- procedure SetHostName(const AValue: String);
- Procedure SetUserName (Value : String);
- Procedure SetPassword (Value : String);
- Function GetPassword : String;
- Function GetClientInfo : String;
- Protected
- Procedure ConnectToServer;
- Procedure SelectDatabase;
- Procedure DoInternalConnect; override;
- Procedure DoInternalDisConnect; override;
- function GetServerStatus: string;
- Public
- Procedure CreateDatabase;
- Procedure DropDatabase;
- Property ServerInfo : String Read FServerInfo;
- Property HostInfo : String Read FHostInfo;
- property ClientInfo: string read GetClientInfo;
- property ServerStatus : String read GetServerStatus;
- Published
- Property UserName : String Read GetUserName Write SetUserName;
- Property HostName : String Read GetHostName Write SetHostName;
- Property Password : String Read GetPassword Write SetPassword;
- TMySQLDataset = class(TDBDataSet)
- FSQL: TStrings;
- // MySQL data
- FMYSQLRES: PMYSQL_RES;
- FCurrentRecord: Integer; { Record pointer }
- FAffectedRows: QWord;
- FLastInsertID: Integer;
- FLoadingFieldDefs: Boolean;
- procedure DoClose;
- procedure DoQuery;
- procedure DoGetResult;
- procedure CalculateSizes;
- procedure LoadBufferFromData(Buffer: PChar);
- Function FMySQL : PMySQL;
- procedure SetSQL(const Value: TStrings);
- function InternalStrToFloat(S: string): Extended;
- function InternalStrToDate(S: string): TDateTime;
- function InternalStrToTime(S: string): TDateTime;
- function InternalStrToDateTime(S: string): TDateTime;
- function InternalStrToTimeStamp(S: string): TDateTime;
- function MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
- var NewType: TFieldType; var NewSize: Integer): Boolean;
- function MySQLDataSize(AType: enum_field_types; ASize: Integer): Integer;
- function MySQLWriteFieldData(AType: enum_field_types; ASize: Integer; Source: PChar;
- Dest: PChar): Integer;
- function GetCanModify: Boolean; override;
- procedure ExecSQL;
- // TDataset method
- property AffectedRows: QWord read FAffectedRows;
- property LastInsertID: Integer read FLastInsertID;
- property Database;
- property SQL: TStrings read FSQL write SetSQL;
- EMySQLError = Class(Exception);
-Resourcestring
- SErrServerConnectFailed = 'Server connect failed.';
- SErrDatabaseSelectFailed = 'failed to select database: %s';
- SErrDatabaseCreate = 'Failed to create database: %s';
- SErrDatabaseDrop = 'Failed to drop database: %s';
- SErrNoData = 'No data for record';
- SErrExecuting = 'Error executing query: %s';
- SErrFetchingdata = 'Error fetching row data: %s';
- SErrGettingResult = 'Error getting result set: %s';
-Procedure MySQlError(R : PMySQL;Msg: String;Comp : TComponent);
- MySQLMsg : String;
- If (R<>Nil) then
- MySQLMsg:=Strpas(mysql_error(R));
- DatabaseErrorFmt(Msg,[MySQLMsg],Comp);
- DatabaseError(Msg,Comp);
-{ TMySQLDataset }
-constructor TMySQLDataset.Create(AOwner: TComponent);
- FAffectedRows := 0;
- FLastInsertID := -1;
- FMYSQLRES := nil;
-destructor TMySQLDataset.Destroy;
- inherited destroy;
-function TMySQLDataset.AllocRecordBuffer: PChar;
-procedure TMySQLDataset.FreeRecordBuffer(var Buffer: PChar);
- If (@Buffer<>nil) then
-procedure TMySQLDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
- PInteger(Data)^ := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
-function TMySQLDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
- Result:=PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag;
-function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
- I, FC: Integer;
- fld: PMYSQL_FIELD;
- CurBuf: PChar;
- CurBuf := ActiveBuffer;
- FC := mysql_num_fields(FMYSQLRES);
- for I := 0 to FC-1 do
- fld := mysql_fetch_field_direct(FMYSQLRES, I);
- if Field.FieldName = fld^.name then
- Move(CurBuf^, PChar(Buffer)^, MySQLDataSize(fld^.ftype, fld^.length));
- if Field.DataType in [ftString{, ftWideString}] then
- Result := PChar(buffer)^ <> #0;
- if Result then
- // Terminate string (necessary for enum fields)
- PChar(buffer)[fld^.length] := #0;
- break;
- Inc(CurBuf, MySQLDataSize(fld^.ftype, fld^.length));
-function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer;
- Result:=GetFieldData(Field, Buffer);
-procedure TMySQLDataset.SetFieldData(Field: TField; Buffer: Pointer;
-function TMySQLDataset.GetRecNo: Integer;
- if (FCurrentRecord=-1) and (RecordCount > 0) then
- Result:=1
- Result:=FCurrentRecord+1;
-function TMySQLDataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
- if RecordCount < 1 then
- Dec(FCurrentRecord);
- if (FCurrentRecord<0) or (FCurrentRecord>=RecordCount) then
- if FCurrentRecord>=RecordCount-1 then
- if (Result=grOK) then
- LoadBufferFromData(Buffer);
- with PMySQLDatasetBookmark(Buffer + FRecordSize)^ do
- if (Result=grError) and (DoCheck) then
- DatabaseError(SerrNoData,Self);
-function TMySQLDataset.GetRecordCount: Integer;
- Result:=mysql_num_rows(FMYSQLRES);
-function TMySQLDataset.GetRecordSize: Word;
- Result:=FRecordSize;
-procedure TMySQLDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
-procedure TMySQLDataset.InternalClose;
- DoClose;
-procedure TMySQLDataset.InternalDelete;
-procedure TMySQLDataset.InternalFirst;
-procedure TMySQLDataset.InternalGotoBookmark(ABookmark: Pointer);
-procedure TMySQLDataset.InternalInitFieldDefs;
- field: PMYSQL_FIELD;
- DFT: TFieldType;
- DFS: Integer;
- WasClosed: Boolean;
- if FLoadingFieldDefs then Exit;
- WasClosed := not IsCursorOpen;
- if WasClosed then
- DoQuery;
- DoGetResult;
- field := mysql_fetch_field_direct(FMYSQLRES, I);
- if MySQLFieldToFieldType(field^.ftype, field^.length, DFT, DFS) then
- TFieldDef.Create(FieldDefs, field^.name, DFT, DFS, False, I+1);
-procedure TMySQLDataset.InternalInitRecord(Buffer: PChar);
-procedure TMySQLDataset.InternalLast;
-procedure TMySQLDataset.InternalOpen;
- CheckDatabase;
- CalculateSizes;
- BookMarkSize:=SizeOf(Longint);
-procedure TMySQLDataset.InternalSetToRecord(Buffer: PChar);
- FCurrentRecord := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
-function TMySQLDataset.IsCursorOpen: Boolean;
- Result:=(FMYSQLRES<>nil);
-procedure TMySQLDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
- PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
-procedure TMySQLDataset.SetBookmarkFlag(Buffer: PChar;
- Value: TBookmarkFlag);
- PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
-procedure TMySQLDataset.SetFieldData(Field: TField; Buffer: Pointer);
-procedure TMySQLDataset.SetRecNo(Value: Integer);
- if (Value >= 0) and (Value <= RecordCount-1) then
- FCurrentRecord := Value-1;
-procedure TMySQLDataset.SetSQL(const Value: TStrings);
- FSQL.Assign(Value);
-procedure TMySQLDataset.ExecSQL;
-procedure TMySQLDataset.InternalPost;
-function TMySQLDataset.MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
- case AType of
- FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
- FIELD_TYPE_INT24:
- NewType := ftInteger;
- NewSize := 0;
- FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
- NewType := ftFloat;
- FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATETIME:
- NewType := ftDateTime;
- FIELD_TYPE_DATE:
- NewType := ftDate;
- FIELD_TYPE_TIME:
- NewType := ftTime;
- FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
- NewType := ftString;
- NewSize := ASize;
-procedure TMySQLDataset.CalculateSizes;
- FRecordSize := FRecordSize + MySQLDataSize(field^.ftype, field^.length);
- FBufferSize := FRecordSize + SizeOf(TMySQLDatasetBookmark);
-procedure TMySQLDataset.LoadBufferFromData(Buffer: PChar);
- I, FC, CT: Integer;
- row: TMYSQL_ROW;
- mysql_data_seek(FMYSQLRES, FCurrentRecord);
- row := mysql_fetch_row(FMYSQLRES);
- if row = nil then
- MySQLError(FMySQL,SErrFetchingData,Self);
- CT := MySQLWriteFieldData(field^.ftype, field^.length, row^, Buffer);
- Inc(Buffer, CT);
- Inc(row);
-function TMySQLDataset.MySQLDataSize(AType: enum_field_types;
- ASize: Integer): Integer;
- Result := 0;
- Result := SizeOf(Integer);
- Result := SizeOf(Double);
- FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATE, FIELD_TYPE_TIME, FIELD_TYPE_DATETIME:
- Result := SizeOf(TDateTime);
- Result := ASize;
-function TMySQLDataset.MySQLWriteFieldData(AType: enum_field_types;
- ASize: Integer; Source, Dest: PChar): Integer;
- VI: Integer;
- VF: Double;
- VD: TDateTime;
- if Source <> '' then
- VI := StrToInt(Source)
- VI := 0;
- Move(VI, Dest^, Result);
- VF := InternalStrToFloat(Source)
- VF := 0;
- Move(VF, Dest^, Result);
- FIELD_TYPE_TIMESTAMP:
- VD := InternalStrToTimeStamp(Source)
- VD := 0;
- Move(VD, Dest^, Result);
- FIELD_TYPE_DATETIME:
- VD := InternalStrToDateTime(Source)
- VD := InternalStrToDate(Source)
- VD := InternalStrToTime(Source)
- Move(Source^, Dest^, Result)
- Dest^ := #0;
-function TMySQLDataset.InternalStrToFloat(S: string): Extended;
- I: Integer;
- Tmp: string;
- Tmp := '';
- for I := 1 to Length(S) do
- if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
- Tmp := Tmp + DecimalSeparator
- Tmp := Tmp + S[I];
- Result := StrToFloat(Tmp);
-function TMySQLDataset.InternalStrToDate(S: string): TDateTime;
- EY, EM, ED: Word;
- EY := StrToInt(Copy(S,1,4));
- EM := StrToInt(Copy(S,6,2));
- ED := StrToInt(Copy(S,9,2));
- if (EY = 0) or (EM = 0) or (ED = 0) then
- Result:=0
- Result:=EncodeDate(EY, EM, ED);
-function TMySQLDataset.InternalStrToDateTime(S: string): TDateTime;
- EH, EN, ES: Word;
- EY := StrToInt(Copy(S, 1, 4));
- EM := StrToInt(Copy(S, 6, 2));
- ED := StrToInt(Copy(S, 9, 2));
- EH := StrToInt(Copy(S, 11, 2));
- EN := StrToInt(Copy(S, 14, 2));
- ES := StrToInt(Copy(S, 17, 2));
- Result := 0
- Result := EncodeDate(EY, EM, ED);
- Result := Result + EncodeTime(EH, EN, ES, 0);
-function TMySQLDataset.InternalStrToTime(S: string): TDateTime;
- EH, EM, ES: Word;
- EH := StrToInt(Copy(S, 1, 2));
- EM := StrToInt(Copy(S, 4, 2));
- ES := StrToInt(Copy(S, 7, 2));
- Result := EncodeTime(EH, EM, ES, 0);
-function TMySQLDataset.InternalStrToTimeStamp(S: string): TDateTime;
- EM := StrToInt(Copy(S, 5, 2));
- ED := StrToInt(Copy(S, 7, 2));
- EH := StrToInt(Copy(S, 9, 2));
- EN := StrToInt(Copy(S, 11, 2));
- ES := StrToInt(Copy(S, 13, 2));
- Result := Result + EncodeTime(EH, EN, ES, 0);;
-procedure TMySQLDataset.DoClose;
- if FMYSQLRES <> nil then
- mysql_free_result(FMYSQLRES);
-procedure TMySQLDataset.DoQuery;
- Query: PChar;
- Query := FSQL.GetText;
- if mysql_query(FMySQL,Query) <> 0 then
- MySQLError(FMYSQL,SErrExecuting,Self);
- StrDispose(Query);
- FAffectedRows := mysql_affected_rows(FMYSQL);
- FLastInsertID := mysql_insert_id(FMYSQL);
-function TMySQLDataset.GetCanModify: Boolean;
-procedure TMySQLDataset.DoGetResult;
- FMYSQLRES := mysql_store_result(FMYSQL);
- if (FMYSQLRES=nil) then
- MySQLError(FMYSQL,SErrGettingResult,Self);
-function TMySQLDataset.FMySQL: PMySQL;
- Result:=(Database as TMySQLDatabase).FMySQL;
-{ TMySQLDatabase }
-function TMySQLDatabase.GetUserName: String;
- result:=Params.values['UserName'];
-function TMySQLDatabase.GetHostName: String;
- Result:=Params.Values['HostName'];
-procedure TMySQLDatabase.SetHostName(const AValue: String);
- Params.Values['HostName']:=AValue;
-procedure TMySQLDatabase.SetUserName(Value: String);
- Params.Values['UserName']:=Value;
-procedure TMySQLDatabase.SetPassword(Value: String);
- Params.Values['Password']:=Value;
-function TMySQLDatabase.GetPassword: String;
- Result:=Params.Values['Password'];
-function TMySQLDatabase.GetClientInfo: String;
- Result:=strpas(mysql_get_client_info);
-procedure TMySQLDatabase.ConnectToServer;
- H,U,P : String;
- if (FMySQL=Nil) then
- New(FMySQL);
- H:=HostName;
- U:=UserName;
- P:=Password;
- FMySQL:=mysql_connect(FMySQL,PChar(H),PChar(U),Pchar(P));
- If (FMySQL=Nil) then
- MySQlError(Nil,SErrServerConnectFailed,Self);
- FServerInfo := strpas(mysql_get_server_info(FMYSQL));
- FHostInfo := strpas(mysql_get_host_info(FMYSQL));
-procedure TMySQLDatabase.SelectDatabase;
- if mysql_select_db(FMySQL,pchar(DatabaseName))<>0 then
- MySQLError(FMySQL,SErrDatabaseSelectFailed,Self);
-procedure TMySQLDatabase.DoInternalConnect;
- if (FMySQL<>nil) then
- DoInternalDisconnect;
- ConnectToServer;
- SelectDatabase;
-procedure TMySQLDatabase.DoInternalDisConnect;
- mysql_close(FMySQL);
- FMySQL:=Nil;
- FServerInfo:='';
- FHostInfo:='';
-procedure TMySQLDatabase.StartTransaction;
- // Nothing yet
-procedure TMySQLDatabase.EndTransaction;
-procedure TMySQLDatabase.CreateDatabase;
- Disconnect : Boolean;
- Disconnect:=(FMySQL=Nil);
- if Disconnect then
- if mysql_create_db(FMySQL,Pchar(DatabaseName))<>0 then
- MySQLError(FMySQL,SErrDatabaseCreate,Self);
- If Disconnect then
-procedure TMySQLDatabase.DropDatabase;
- if mysql_drop_db(FMySQL,Pchar(DatabaseName))<>0 then
- MySQLError(FMySQL,SErrDatabaseDrop,Self);
-function TMySQLDatabase.GetServerStatus: string;
- CheckConnected;
- Result := mysql_stat(FMYSQL);
@@ -1,982 +0,0 @@
-unit MySQLDB4;
- SysUtils, Classes, db, mysql4,mysql4_com;
- function MySQLDataSize(AType: enum_field_types; ASize,AAltSize : Integer): Integer;
- Support_Blob : boolean = true;
- I, FC, Len: Integer;
- Len := MySQLDataSize(fld^.ftype, fld^.length,fld^.max_length);
- Move(CurBuf^, PChar(Buffer)^, Len);
- PChar(buffer)[Len] := #0;
- Inc(CurBuf, Len);
- Field: PMYSQL_FIELD;
- DFS, Len: Integer;
- Field := mysql_fetch_field_direct(FMYSQLRES, I);
- Len := MySqlDataSize(Field^.FType, Field^.length, Field^.max_length);
- if MySQLFieldToFieldType(Field^.ftype, len, DFT, DFS) then
- FIELD_TYPE_BLOB :
- if Support_blob then
- Result := false;
- FRecordSize := FRecordSize + MySQLDataSize(field^.ftype, field^.length,field^.max_length);
- I, FC, CT, Len: Integer;
- Len := MySqlDataSize(field^.ftype, field^.length, field^.max_length);
- CT := MySQLWriteFieldData(field^.ftype, Len, row^, Buffer);
- ASize,AAltSize: Integer): Integer;
- FIELD_TYPE_BLOB:
- Result:= ASize;
- if (AAltSize>=0) and (AAltSize<ASize) then
- Result:=AAltSize;
- Result:=0;
- EY, EM, ED: Longint;
- SScanf(S,'%d-%d-%d',[@EY,@EM,@ED]);
- EH, EN, ES: Longint;
- SScanf(S,'%d-%d-%d %d:%d:%d',[@EY,@EM,@ED,@EH,@EN,@ES]);
- EH := StrToInt(Copy(S, 12, 2));
- EN := StrToInt(Copy(S, 15, 2));
- ES := StrToInt(Copy(S, 18, 2));
- EH, EM, ES: Longint;
- SScanf(S,'%d:%d:%d',[@EH,@EM,@ES]);
- EY, EM, ED: longint;
- EH, EN, ES: longint;
- mysql_init(FMySQL);
- FMySQL:=mysql_real_connect(FMySQL,PChar(H),PChar(U),Pchar(P),Nil,0,Nil,0);
- {if mysql_create_db(FMySQL,Pchar(DatabaseName))<>0 then
- MySQLError(FMySQL,SErrDatabaseCreate,Self);}
-}
@@ -1,2269 +0,0 @@
-override TARGET_UNITS+=fpodbc
-override TARGET_EXAMPLES+=testbcon testcon testdrcon testenv testfl testpa testpktestpr testsql testst testtl
-override REQUIRE_PACKAGES=rtl odbc
-ifdef REQUIRE_PACKAGES_ODBC
-PACKAGEDIR_ODBC:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /odbc/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_ODBC),)
-ifneq ($(wildcard $(PACKAGEDIR_ODBC)/units/$(TARGETSUFFIX)),)
-UNITDIR_ODBC=$(PACKAGEDIR_ODBC)/units/$(TARGETSUFFIX)
-UNITDIR_ODBC=$(PACKAGEDIR_ODBC)
-$(PACKAGEDIR_ODBC)/$(FPCMADE):
- $(MAKE) -C $(PACKAGEDIR_ODBC) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_ODBC)/$(FPCMADE)
-PACKAGEDIR_ODBC=
-UNITDIR_ODBC:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /odbc/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_ODBC),)
-UNITDIR_ODBC:=$(firstword $(UNITDIR_ODBC))
-UNITDIR_ODBC=
-ifdef UNITDIR_ODBC
-override COMPILER_UNITDIR+=$(UNITDIR_ODBC)
@@ -1,30 +0,0 @@
-# Makefile.fpc for fpODBC db units
-units=fpodbc
-examples=testbcon testcon testdrcon testenv testfl testpa testpk\
- testpr testsql testst testtl
-units=
-packages=odbc
@@ -1,181 +0,0 @@
-fpODBC - a OOP wrapper around the ODBC driver.
-This is a simple OOP wrapper around teh ODBC data calls.
-There are basically 3 classes:
-TODBCEnvironment
-----------------
- A global object the contains the connection to the ODBC driver. Each
- connection should have an environment assigned to it. If not, a
- default environment will be used.
- It has the following methods:
- Function GetDriverNames(List : Tstrings) : Integer;
- Fills list with the available drivers. Returns the number of
- drivers.
- Function GetDataSourceNames(List : Tstrings; Types : TDSNTypes;Descriptions : Boolean) : Integer;
- Fills list with the available datasources.
- Types is one of
- dtUser : Return only user DSNs
- dtSystem : Return system DSNs
- dtBoth : Return both
- The function returns the number of returned drivers.
- function GetDriverOptions(Driver: String; Options: TStrings): Integer;
- Returns a list of options for the driver.
-TODBCConnection
- Represents a connection to a ODBC datasource.
- The connection is established according to the following rules:
- - If OnBrowseConnection is assigned, SQLBrowseConnect is used. At
- each browse step, the handler is called with the in and out
- parameter lists filled.
- TConnectionBrowseEvent = Procedure (Sender : TObject;InParams,OutParams : Tstrings) of Object;
- This is as yet untested, since I have no driver which supports it.
- - If the DSN property is assigned, this is used. Password and Username are also used.
- - If The drivername is assigned, that is used, together with the
- DriverParams. This should be a list name=value pairs which will be
- passed to the driver.
- - If none of the above conditions is fullfilled, an error is raised.
- - To connect, set the Active property to 'True' or call connect.
- - To Disconnect, set the active property to false or call disconnect
- The following methods exist:
- Procedure Connect;
- Connects to the DSN/Driver
- Procedure Disconnect;
- Disconnects from the DSN/Driver
- Procedure GetTableNames(S : TStrings; SystemTables : Boolean);
- returns a list of tables. If systemtables is true, then system
- table names are also returned.
- Procedure GetFieldNames(TableName : String; S : TStrings);
- returns a list of fieldnames for table 'tablename'
- Procedure GetPrimaryKeyFields(TableName : String; S : TStrings);
- returns a list of primary key fieldnames for table 'tablename'
- procedure GetProcedureNames(S : TStrings);
- returns a list of stored procedure names
- procedure GetProcedureParams(ProcName : String;ParamTypes : TODBCParamTypes; S : TStrings);
- returns a list of parameters for the stored procedure. ParamTypes is a set of
- ptUnknown,ptInput,ptInputOutput,ptResult,ptOutput,ptRetVal
-TODBCStatement / TODBCSQLStatement.
- TODBCStatement is an abstract class which encapsulates an ODBC Statement
- handle. TODBCSQLStatement accepts an SQL Query which it can execute.
- TODBCStatement has the following methods:
- Procedure BindFields(RestrictList : TStrings);virtual;
- Binds fields. If restrictlist is assigned, then only fields whose
- name appears in the list are bound.
- Procedure ClearFields;virtual;
- clears the field definitions.
- Function Fetch : Boolean;
- fetches the next row. Is false if there was no more data.
- Property Connection : TODBCConnection Read FConnection Write SetConnection;
- The connection object to use.
- Property BOF : Boolean read FBOF;
- True if at beginning of data
- Property EOF : Boolean read FEOF;
- True if at end of data
- Property Fields : TODBCFieldList Read FFields;
- Collection of fields in result set (if any)
- TODBCSQLStatement has the following extra methods/properties:
- procedure Prepare;
- prepares the query. After this, Bindfields may be called.
- procedure Unprepare;
- unprepares the query. After this, Bindfields nor execute may be called.
- executes the SQL query. If it was not prepared it is executed
- directly.
- Procedure Open;
- prepares the query, binds all fields, allocates buffers and
- fetches the first row of the result set.
- Procedure Close;
- Undoes the 'Open'
- procedure GetFieldList(List: TStrings);
- Retsurns a list of field names in the result set. Can only be
- called after Prepare/Open and before close.
- Property Active : Boolean Read GetActive Write SetActive;
- Setting Active to true is the same as calling open.
- Setting it to false is the same as calling close.
- Property SQL : TStrings
- The SQL statement to be executed.
- A query result is returned in a collection of TODBCField objects:
-TODBCField :
- Property Position : SQLSmallint Read FPosition;
- (position in the query)
- Property Name : String read FName;
- (name of the field)
- Property DataType : SQLSmallInt read FDatatype;
- (original SQL data type)
- Property Size : SQLUinteger read FSize;
- (Original SQL data size)
- property DecimalDigits : SQLSmallInt read FDecimalDigits;
- (Original SQL digits after decimal point)
- Property Nullable : Boolean Read FNullable;
- (Field is nullable ?)
- Property Data : Pchar Read GetData;
- (pointer to raw data)
- Property BufType : SQLSmallInt Read FBufType;
- (SQL type of the allocated data buffer)
- Property BufSize : SQLInteger Read FBufSize;
- (Allocated size of the buffer)
- Property IsNull : Boolean Read GetIsNull;
- (Was the returned field value null ?)
- Property AsString : String Read GetAsString;
- Field value as string.
- Property AsInteger : Integer Read GetAsInteger;
- Field value as integer.
- Property AsBoolean : Boolean Read GetAsBoolean;
- Field value as boolean.
- Property AsDouble : Double Read GetAsDouble;
- Field value as DOUBLE
- Property AsDateTime : TDateTime Read GetAsDateTime;
- Field value as TDateTime
- The latter properties do some basic conversion i.e.
- if the result is an integer, the AsString will return
- the integer value converted to a string.
- Blob is not yet supported, but should be soon.
-List of examples:
-Program test functionality
-------- -----------------
-testbcon.pp tests browseconnect.
-testcon.pp tests DSN connect.
-testdrcon.pp tests driverconnect.
-testenv.pp test ennvironment functions.
-testfl.pp test fieldlist.
-testodbc.pp test raw odbc.
-testpa.pp test procedure arguments.
-testpk.pp test primary key lists.
-testpr.pp test procedure list.
-testsql.pp test execution of SQL and retrieval of results.
-testst.pp test preparing of a statement.
-testtl.pp test table list.
@@ -1,1464 +0,0 @@
-unit fpodbc;
-{$h+}
-uses odbcsql,SysUtils,Classes;
-Type
- TDSNTypes = (dtUser,dtSystem,dtBoth);
- TODBCParamType = (ptUnknown,ptInput,ptInputOutput,ptResult,ptOutput,ptRetVal);
- TODBCParamTypes = Set of TODBCParamType;
- TODBCObject = Class(TComponent)
- FHandle : SQLHandle;
- FHandleType : SQLSmallint;
- Function GetHandle : SQLHandle;
- function GetHandleAllocated: Boolean;
- function GetExtendedErrorInfo: String;
- Function CreateHandle : SQLHandle; Virtual;
- Function ParentHandle : SQLHandle; Virtual;
- Procedure FreeHandle;
- Function CheckODBC(Res : Integer;Msg : String) : Integer;
- Destructor Destroy; override;
- Property Handle : SQLHandle Read GetHandle;
- Property HandleAllocated : Boolean Read GetHandleAllocated;
- TODBCEnvironment = Class(TODBCObject)
- FODBCBehaviour : Integer;
- procedure SetODBCbehaviour(const Value: Integer);
- function GetNullTerminate: Boolean;
- procedure SetNullTerminate(const Value: Boolean);
- function CreateHandle: SQLHandle; override;
- Procedure SetIntAttribute(Const Attr,Value : Integer);
- Procedure SetStringAttribute(Const Attr: Integer; Value : String);
- Function GetIntAttribute(Const Attr : Integer) : Integer;
- Function GetStringAttribute(Const Attr : Integer) : String;
- Constructor Create(Aowner : TComponent);override;
- Property ODBCBehaviour : Integer Read FODBCBehaviour Write SetODBCbehaviour;
- Property NullTerminateStrings : Boolean Read GetNullTerminate Write SetNullTerminate;
- TODBCConnection = Class(TODBCObject)
- FActive : Boolean;
- FDriverParams : TStrings;
- FDSN,
- FDriverName,
- FUserName,
- FPassword : String;
- FEnvironMent : TODBCEnvironment;
- FOnBrowseConnection : TConnectionBrowseEvent;
- FWindowHandle : integer;
- FDriverCOmpletion: SQLUSmallInt;
- function GetDriverName: String;
- function GetDriverParams: TStrings;
- procedure SetActive(const Value: Boolean);
- procedure SetDriverName(const Value: String);
- procedure SetDriverParams(const Value: TStrings);
- procedure SetDSN(const Value: String);
- function GetEnvironment: TODBCEnvironMent;
- procedure SetEnvironment(const Value: TODBCEnvironMent);
- procedure ConnectToDriver;
- procedure ConnectToDSN;
- Procedure ConnectBrowsing;
- Function ParentHandle : SQLHandle; override;
- Procedure CheckActive;
- Procedure CheckInActive;
- Property DSN : String Read FDSN Write SetDSN;
- Property DriverName : String Read GetDriverName Write SetDriverName;
- Property DriverCompletion : SQLUSmallInt Read FDriverCOmpletion Write FDriverCompletion;
- Property DriverParams : TStrings Read GetDriverParams Write SetDriverParams;
- Property Active : Boolean Read FActive Write SetActive;
- Property Environment : TODBCEnvironMent Read GetEnvironment Write SetEnvironment;
- Property UserName : String Read FUserName Write FUserName;
- Property Password : string Read FPassword Write FPassword;
- Property OnBrowseConnection : TConnectionBrowseEvent Read FonBrowseConnection Write FOnBrowseConnection;
- Property WindowHandle : integer Read FWindowHandle Write FWindowHandle;
- TODBCStatement = Class;
- TODBCFieldList = Class(TCollection)
- FStatement : TODBCStatement;
- Constructor Create(Statement : TODBCStatement);
- TODBCStatement allocates 1 big data buffer. For each bound field
- two things are allocated in the buffer:
- - Size of fetched data as filled in by fetch.
- - data. (may be zero for blobs etc)
- The FBuffOffset contains the offset in the buffer of the size field.
- Data immediatly follows the size.
- TODBCField = Class(TCollectionItem)
- FDecimalDigits,
- FPosition : SQLSmallInt;
- FName : String;
- FSize : SQLUInteger; // Declared size, as returned by DescribeCol
- FNullable : Boolean;
- FDataType : SQLSmallInt; // Declared type, as returned by DescribeCol
- FBuffOffSet : SQLInteger; // Offset in data buffer.
- FBuffer : Pointer; // Pointer to data.
- FBufSize : SQLInteger; // Allocated buffer size.
- FBufType : SQLSmallInt; // Allocated buffer type
- function GetAsString: String;
- function GetData : PChar;
- Function GetIsNull : Boolean;
- Function GetAsInteger : Integer;
- Function GetAsBoolean : Boolean;
- Function GetAsDouble : Double;
- Function GetAsDateTime : TDateTime;
- TODBCStatement = Class(TODBCObject)
- FBOF,FEOF : Boolean;
- FConnection: TODBCConnection;
- FFields : TODBCFieldList;
- FBuffer : Pointer;
- procedure SetConnection(const Value: TODBCConnection);
- procedure AllocBuffers;
- TODBCTableList = Class(TODBCStatement)
- TODBCFieldNamesList = Class(TODBCStatement)
- Procedure GetFieldNames(TableName : String;S : TStrings);
- TODBCPrimaryKeyFieldsList = Class(TODBCStatement)
- Procedure GetPrimaryKeyFields(TableName : String;S : TStrings);
- TODBCProcedureList = Class(TODBCStatement)
- Procedure GetProcedureList(S : TStrings);
- TODBCProcedureParams = Class(TODBCStatement)
- Procedure GetProcedureParams(ProcName: String; ParamTypes: TODBCParamTypes; S: TStrings);
- TStatementState = (ssInactive,ssPrepared,ssBound,ssOpen);
- TODBCSQLStatement = Class(TODBCStatement)
- FState : TStatementState;
- function GetActive: Boolean;
- procedure FreeStatement(Option: SQLUSMALLINT);
- procedure ExecuteDirect;
- procedure ExecutePrepared;
- Procedure SetSQL(const Value: TStrings);
- Procedure BindFields(RestrictList : TStrings);override;
- Property SQL : TStrings Read FSQL Write SetSQL;
- EODBCError = Class(Exception);
-Const
- ODBCParamTypeNames : Array [TODBCParamType] of string
- = ('Unknown','Input','Input/Output','Result','Output','RetVal');
-Function DefaultEnvironment : TODBCEnvironment;
-{ TODBCObject }
-resourcestring
- SErrUnexpected = 'Unexpected ODBC error:';
- SErrEnvironmentHandle = 'Cannot allocate environment handle:';
- SErrInvalidBehaviour = 'Invalid value for ODBC behaviour: %d';
- SErrNotConnected = 'Operation invalid when not connected.';
- SErrConnected = 'Operation invalid when connected.';
- SNeedDSNOrDriver = 'Cannot connect with empty DSN and driver names.';
- SErrGettingDataSources = 'Error getting datasources:';
- SErrGettingDriverNames = 'Error getting driver names:';
- SErrGettingDriverOptions = 'Error getting driver options:';
- SErrSettingEnvAttribute = 'Error setting environment attribute:';
- SErrGettingEnvAttribute = 'Error Getting environment attribute:';
- SErrBrowseConnecting = 'Error connecting to datasource via browse:';
- SErrDSNConnect = 'Error connecting to DSN:';
- SErrDriverConnect = 'Error connecting to driver:';
- SErrDisconnecting = 'Error disconnecting:';
- SErrNoConnectionForStatement = 'Missing connection for statement.';
- SErrNoSQLStatement = 'Missing SQL statement.';
- SErrPreparing = 'Error preparing statement:';
- SErrGettingTableNames = 'Error getting table names:';
- SErrFetchingData = 'Error fetching data:';
- SErrFieldNames = 'Error getting field names:';
- SErrPrimaryKeys = 'Error getting primary key names:';
- SErrProcedureNames = 'Error getting procedure names:';
- SErrExecuting = 'Error while executing statement:';
- SErrExecutingPrepared = 'Error while executing prepared statement:';
- SErrNotPrepared = 'Statement is not prepared';
- SErrNotInactive = 'Statement is already prepared or executed.';
- SErrStatementActive = 'A statement is still active';
- SErrColumnCount = 'Error retrieving cilumn count:';
- SErrColDescription = 'Error retrieving column description';
- SErrInvalidConversion = 'invalid type conversion';
- SErrBindCol = 'Error binding column';
- ODBCSuccess = [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO];
-Procedure ODBCError (Msg : String);
- Raise EODBCError.Create(Msg);
-Procedure ODBCErrorFmt (Fmt : String;Args : Array of const);
- Raise EODBCError.CreateFmt(Fmt,Args);
-Function CheckODBC(Res : Integer;Msg : String) : Integer;
- Result:=Res;
- if not Res in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then
- If MSG='' then
- MSG:=SErrUnexpected;
- ODBCErrorFmt(msg,[res]);
-function TODBCObject.CheckODBC(Res: Integer; Msg: String): Integer;
-Var S : String;
- S:=GetExtendedErrorInfo;
- If S<>'' then
- Msg:=Msg+LineEnding+S;
- ODBCError(msg);
-function TODBCObject.GetExtendedErrorInfo : String;
- Res : SQLreturn;
- I,MsgLen : SQLSmallInt;
- SQLState : Array[0..6] of Char;
- NativeError : SQLInteger;
- MSg : Array[0..SQL_MAX_MESSAGE_LENGTH] of Char;
- SState,SMsg : String;
- I:=0;
- Result:='';
- Repeat
- Inc(i);
- Res:=SQLGetDiagRec(FhandleType, FHandle, i, SqlState, NativeError,
- Msg, sizeof(Msg), MsgLen);
- If Res<>SQL_NO_DATA then
- SState:=SQLState;
- SMsg:=Msg;
- If Length(Result)>0 then
- Result:=Result+LineEnding;
- Result:=Result+Format('[%s] : %s (%d)',[SState,SMsg,NativeError]);
- Until (Res=SQL_NO_DATA);
-function TODBCObject.CreateHandle: SQLHandle;
-{$ifdef debug}
- Writeln(Classname,': Creating handle of type ',FHAndleType,' and parent ',ParentHandle);
- CheckODBC(SQLAllocHandle(FHandleType,ParentHandle,FHandle),SErrEnvironmentHandle);
- Result:=FHandle;
-destructor TODBCObject.Destroy;
- If FHandle<>0 then
- FreeHandle;
-procedure TODBCObject.FreeHandle;
- SQLFreeHandle(FHandleType,FHandle);
- FHandle:=0;
-function TODBCObject.GetHandle: SQLHandle;
- If FHandle=0 then
- CreateHandle;
-function TODBCObject.GetHandleAllocated: Boolean;
- Result:=(FHandle<>0)
-function TODBCObject.ParentHandle: SQLHandle;
- Result:=SQL_NULL_HANDLE;
-{ TODBCEnvironment }
-constructor TODBCEnvironment.Create(Aowner: TComponent);
- FHandleType:=SQL_HANDLE_ENV;
-function TODBCEnvironment.CreateHandle: SQLHandle;
- Result:=Inherited CreateHandle;
- ODBCbehaviour:=SQL_OV_ODBC3;
-function TODBCEnvironment.GetDataSourceNames(List: Tstrings;
- Types: TDSNTypes;Descriptions : Boolean): Integer;
- DSNName,
- DSNDesc: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
- lenn,lend : SQLSmallInt;
- Dir : SQLSmallInt;
- Sn,SD : String;
- Case Types of
- dtSystem : Dir:=SQL_FETCH_FIRST_SYSTEM;
- dtUser : Dir:=SQL_FETCH_FIRST_USER;
- dtBoth : Dir:=SQL_FETCH_FIRST;
- List.Clear;
- CheckODBC(SQLDatasources(Handle, Dir,
- DSNName,SQL_MAX_OPTION_STRING_LENGTH, @lenn,
- DSNDesc,SQL_MAX_OPTION_STRING_LENGTH, @lend),SErrGettingDataSources);
- If Not Descriptions then
- List.Add(DSNName)
- SN:=DSNName;
- SD:=DSNDesc;
- List.Add(SN+'='+SD);
- Until Not (SQLDataSources(Handle, SQL_FETCH_NEXT,
- DSNName, SQL_MAX_OPTION_STRING_LENGTH, @lenn,
- DSNDesc,SQL_MAX_OPTION_STRING_LENGTH, @lend) in ODBCSuccess);
- Result:=List.Count;
-function TODBCEnvironment.GetDriverNames(List : Tstrings): Integer;
- DriverName: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
- len : SQLSmallInt;
- CheckODBC(SQLDrivers(Handle, SQL_FETCH_FIRST, DriverName,
- SQL_MAX_OPTION_STRING_LENGTH, @len, Nil,0,Nil),SErrGettingDriverNames);
- List.Add(DriverName);
- Until Not (SQLDrivers(Handle, SQL_FETCH_NEXT, DriverName,
- SQL_MAX_OPTION_STRING_LENGTH, @len, Nil,0,Nil) in ODBCSuccess);
-function TODBCEnvironment.GetDriverOptions(Driver : String;Options: Tstrings): Integer;
- DriverName,
- DriverOptions: array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
- lenn,leno : SQLSmallInt;
- Found : Boolean;
- P : PChar;
- S : string;
- SQL_MAX_OPTION_STRING_LENGTH, @lenn, DriverOptions,
- SQL_MAX_OPTION_STRING_LENGTH,@Leno),SErrGettingDriverOptions);
- Options.Clear;
- Found:=CompareText(Driver,DriverName)=0;
- If Found then
- P:=@DriverOptions[0];
- While P[0]<>#0 do
- S:=StrPas(P);
- options.Add(S);
- Inc(P,Length(S)+1);
- SQL_MAX_OPTION_STRING_LENGTH,@Leno) in ODBCSuccess) or Found;
- Result:=Options.Count;
-function TODBCEnvironment.GetIntAttribute(const Attr: Integer): Integer;
- CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(@result),0),SErrSettingEnvAttribute);
-function TODBCEnvironment.GetNullTerminate: Boolean;
- Result:=(GetIntAttribute(SQL_ATTR_OUTPUT_NTS)=SQL_TRUE);
-function TODBCEnvironment.GetStringAttribute(const Attr: Integer): String;
- OldLen,Len: Integer;
- OldLen:=0;
- Inc(OldLen,255);
- SetLength(Result,OldLen);
- CheckODBC(SQLGetEnvAttr(Handle,Attr,SQLPointer(@result),OldLen,@Len),SErrGettingEnvAttribute);
- until (Len<=OldLen);
- SetLength(Result,Len);
-procedure TODBCEnvironment.SetIntAttribute(const Attr, Value: Integer);
- CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(Value),0),SErrSettingEnvAttribute);
-procedure TODBCEnvironment.SetNullTerminate(const Value: Boolean);
- If Value then
- SetIntAttribute(SQL_ATTR_OUTPUT_NTS,SQL_TRUE)
- SetIntAttribute(SQL_ATTR_OUTPUT_NTS,SQL_FALSE);
-procedure TODBCEnvironment.SetODBCbehaviour(const Value: Integer);
- If (Value<>FODBCBehaviour) then
- If Not (Value in [SQL_OV_ODBC3,SQL_OV_ODBC2]) Then
- ODBCErrorFmt(SErrInvalidBehaviour,[Value]);
- SetIntAttribute(SQL_ATTR_ODBC_VERSION,Value);
- FODBCBehaviour := Value;
-procedure TODBCEnvironment.SetStringAttribute(const Attr: Integer;
- Value: String);
- CheckODBC(SQLSetEnvAttr(Handle,Attr,SQLPointer(Value),Length(Value)),SErrSettingEnvAttribute);
-{ TODBCConnection }
-procedure TODBCConnection.CheckActive;
- If Not FActive then
- ODBCError(SErrNotConnected);
-procedure TODBCConnection.CheckInActive;
- If FActive then
- ODBCError(SErrConnected);
-procedure TODBCConnection.Connect;
- If Assigned (FonBrowseConnection) then
- ConnectBrowsing
- else If (FDSN<>'') then
- ConnectToDSN
- else if FDriverName<>'' then
- ConnectToDriver
- ODBCError(SNeedDSNOrDriver);
- FActive:=True;
-Function ListToBuf(List : Tstrings; Buf : PChar; Sep : Char; MaxLen : Integer) : Boolean;
- I,Len : Integer;
- P:=Buf;
- Result:=True;
- While Result and (I<List.Count) do
- S:=List[i];
- If I<List.Count-1 then
- S:=S+Sep;
- Len:=Length(S);
- Result:=(Longint(P-Buf)+Len)<=MaxLen;
- If Result then
- Move(S[1],P^,Len);
- Inc(P,Len);
- P[0]:=#0;
-Function BufToList(Buf : PChar;MaxLen : Integer;List : Tstrings;Sep : Char) : Integer;
- Totlen,Len : Integer;
- TotLen:=0;
- While (P[0]<>#0) or (totlen<Maxlen) do
- Len:=0;
- While Not (P[len] in [Sep,#0]) do
- Inc(len);
- SetLength(S,Len);
- List.Add(S);
- Move(P[0],S[1],Len);
- If P[0]<>#0 then
- Inc(P,1);
- inc(Totlen,Len+1);
-Procedure TODBCConnection.ConnectBrowsing;
- Inlist,OutList : TStringList;
- InStr,
- OutStr: Array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
- i,Res : Integer;
- olen : SQLSmallint;
- InList:=TStringList.Create;
- OutList:=TstringList.Create;
- If FDSN<>'' then
- InList.Add('DSN='+FDSN)
- else If FDriverName<>'' then
- Inlist.Add('DRIVER='+FDriverName);
- For I:=0 to DriverParams.Count-1 do
- Inlist.Add(DriverParams[i]);
- ListToBuf(Inlist,Instr,';',SQL_MAX_OPTION_STRING_LENGTH);
- Res:=SQLBrowseConnect(Handle,Instr,SQL_NTS,Outstr,SQL_MAX_OPTION_STRING_LENGTH,Olen);
- If RES=SQL_NEED_DATA then
- OutList.Clear;
- BufToList(OutStr,Olen,OutList,';');
- FOnBrowseConnection(Self,InList,OutList);
- Until (Res<>SQL_NEED_DATA);
- CheckODBC(Res,SErrBrowseConnecting);
- Outlist.free;
- InList.Free;
-Procedure TODBCConnection.ConnectToDSN;
- CheckODBC(SQLConnect(Handle,PSQLChar(FDSN),SQL_NTS,
- PSQLChar(FUserName),SQL_NTS,
- PSQLChar(FPassword),SQL_NTS),SErrDSNConnect);
-Procedure TODBCConnection.ConnectToDriver;
- Instr,
- OutStr : Array[0..SQL_MAX_OPTION_STRING_LENGTH] of Char;
- OLen : SQLSmallint;
- InList : TStringList;
- Inlist.Assign(DriverParams);
- Inlist.Insert(0,'DRIVER={'+DRIVERNAME+'}');
- ListToBuf(Inlist,InStr,';',SQL_MAX_OPTION_STRING_LENGTH);
- Inlist.Free;
- CheckODBC(SQLDriverConnect(Handle,FWindowHandle,
- Instr,SQL_NTS,
- OutStr,SQL_MAX_OPTION_STRING_LENGTH,
- Olen,FDriverCompletion),SErrDriverConnect);
-constructor TODBCConnection.Create(Aowner: TComponent);
- FHandleType:=SQL_HANDLE_DBC;
- FDriverParams:=TStringList.Create;
- FDriverCompletion:=SQL_DRIVER_NOPROMPT;
-destructor TODBCConnection.Destroy;
- Disconnect;
-procedure TODBCConnection.Disconnect;
- CheckODBC(SQLDisconnect(Handle),SErrDisconnecting);
- Factive:=False;
-function TODBCConnection.GetDriverName: String;
- Result:=FDriverName;
-function TODBCConnection.GetDriverParams: TStrings;
- Result:=FDriverParams;
-function TODBCConnection.GetEnvironment: TODBCEnvironMent;
- If FEnvironment=Nil then
- result:=DefaultEnvironment
- Result:=FEnvironment;
-procedure TODBCConnection.SetActive(const Value: Boolean);
- Connect
-procedure TODBCConnection.SetDriverName(const Value: String);
- FDSN:='';
- If CompareText(FDriverName,Value)<>0 then
- FDriverName:=Value;
- FDriverParams.Clear;
-procedure TODBCConnection.SetDriverParams(const Value: TStrings);
- FDriverParams.Assign(Value);
-procedure TODBCConnection.SetDSN(const Value: String);
- FDSN := Value;
-procedure TODBCConnection.SetEnvironment(const Value: TODBCEnvironMent);
- If (Value<>Environment) then // !! may be defaultenvironment...
- If HandleAllocated then
- FEnvironment:=Value
-function TODBCConnection.ParentHandle: SQLHandle;
- Result:=Environment.Handle
- DefEnv : Pointer = Nil;
- If DefEnv=Nil then
- DefEnv:=TODBCEnvironment.Create(Nil);
- Result:=TODBCEnvironment(DefEnv);
-procedure TODBCConnection.GetTableNames(S: TStrings;
- SystemTables: Boolean);
- With TODBCTableList.Create(Self) do
- GetTableNames(S,SystemTables);
-procedure TODBCConnection.GetFieldNames(TableName: String; S: TStrings);
- With TODBCFieldNamesList.Create(Self) do
- GetFieldNames(TableName,S);
-procedure TODBCConnection.GetPrimaryKeyFields(TableName: String;
- S: TStrings);
- With TODBCPrimaryKeyFieldsList.Create(Self) do
- GetPrimaryKeyFields(TableName,S);
-procedure TODBCConnection.GetProcedureNames(S: TStrings);
- With TODBCProcedureList.Create(Self) do
- GetProcedureList(S);
-procedure TODBCConnection.GetProcedureParams(ProcName: String;
- ParamTypes: TODBCParamTypes; S: TStrings);
- With TODBCProcedureParams.Create(Self) do
- GetProcedureParams(ProcName,Paramtypes,S);
-{ TODBCStatement }
- TODBCFieldBufRec = Record
- T{ype} : SQlSmallint;
- B{ufsize} : SQLInteger;
- {Buftyp}e : SQLSmallint;
- BufDescrCount = 26;
- BufDescr : Array[1..BufDescrCount] of TODBCFieldBufRec =
- { Type Bufsize Buftype }
- (
- (T:SQL_CHAR ;b:-1 ;e: SQL_CHAR),
- (T:SQL_NUMERIC ;b:sizeof(SQLDouble) ;e: SQL_DOUBLE),
- (T:SQL_DECIMAL ;b:sizeof(SQLDouble) ;e: SQL_DOUBLE),
- (T:SQL_INTEGER ;b:sizeof(SQLInteger) ;e: SQL_INTEGER),
- (T:SQL_SMALLINT ;b:sizeof(SQLSmallInt) ;e: SQL_SMALLINT),
- (T:SQL_FLOAT ;b:sizeof(SQLDOUBLE) ;e: SQL_DOUBLE),
- (T:SQL_REAL ;b:sizeof(SQLDOUBLE) ;e: SQL_DOUBLE),
- (T:SQL_DOUBLE ;b:Sizeof(SQLDOUBLE) ;e: SQL_DOUBLE),
- (T:SQL_DATE ;b:Sizeof(SQL_DATE_STRUCT) ;e: SQL_DATE),
- (T:SQL_TIME ;b:sizeof(SQL_TIME_STRUCT) ;e: SQL_TIME),
- (T:SQL_TIMESTAMP ;b:sizeof(SQL_TIMESTAMP_STRUCT) ;e: SQL_TIMESTAMP),
- (T:SQL_VARCHAR ;b:-1 ;e: SQL_CHAR),
- (T:SQL_UNKNOWN_TYPE ;b:0 ;e: SQL_UNKNOWN_TYPE),
- (T:SQL_LONGVARCHAR ;b:-1 ;e: SQL_CHAR),
- (T:SQL_BINARY ;b:-2 ;e: SQL_BINARY),
- (T:SQL_VARBINARY ;b:-2 ;e: SQL_BINARY),
- (T:SQL_LONGVARBINARY ;b:-2 ;e: SQL_BINARY),
- (T:SQL_BIGINT ;b:sizeOf(SQLDOUBLE) ;e: SQL_DOUBLE),
- (T:SQL_TINYINT ;b:Sizeof(SQLSMALLINT) ;e: SQL_SMALLINT),
- (T:SQL_BIT ;b:sizeof(SQL_CHAR) ;e: SQL_BIT),
- (T:SQL_WCHAR ;b:-1 ;e: SQL_CHAR),
- (T:SQL_WVARCHAR ;b:-1 ;e: SQL_CHAR),
- (T:SQL_WLONGVARCHAR ;b:-1 ;e: SQL_CHAR),
- (T:SQL_TYPE_DATE ;b:sizeof(SQL_DATE_STRUCT) ;e: SQL_TYPE_DATE),
- (T:SQL_TYPE_TIME ;b:sizeof(SQL_TIME_STRUCT) ;e: SQL_TYPE_TIME),
- (T:SQL_TYPE_TIMESTAMP;b:sizeof(SQL_TIMESTAMP_STRUCT) ;e: SQL_TYPE_TIMESTAMP)
- );
-{ // template
- (T: ;b: ;e: ),
-Function GetColSizeBufType (Coltype: SQLSmallint;
- Var BufSize : SQLInteger;
- Var BufType : SQLSmallInt) : Boolean;
- BufSize:=0;
- BufType:=0;
- While (I<=BufDescrCount) and (BufDescr[i].t<>Coltype) do
- Result:=(i<=BufDescrCount);
- BufSize:=BufDescr[i].b;
- BufType:=BufDescr[i].e;
-procedure TODBCStatement.BindFields(RestrictList : TStrings);
- Count: SQLSmallInt;
- CName : Array[0..SQL_NAME_LEN] of Char;
- CSize : SQLUINTEGER;
- CDataType,CDecimals,CNullable,CNameLen: SQLSmallInt;
- I : integer;
- CheckODBC(SQLNumResultCols(Handle,Count),SErrColumnCount);
- For I:=1 to Count do
- CheckODBC(SQLDescribeCol(Handle,i,CName,SQL_NAME_LEN,CNameLen,
- CdataType,CSize, CDecimals,CNullable)
- ,SErrColDescription);
- If Not Assigned(RestrictList) or (RestrictList.IndexOf(Cname)<>-1) then
- With FFields.Add as TODBCField do
- FPosition:=I;
- FName:=Cname;
- FDataType:=CDataType;
- FSize:=CSize;
- FDecimalDigits:=CDecimals;
- FNullable:=(CNullable=SQL_TRUE);
- GetColsizeBufType(FDataType,FBufSize,FBufType);
- If FBufSize=-1 then
- FBufSize:=FSize;
- AllocBuffers;
- For I:=0 to Count-1 do
- With FFields.Items[i] as TODBCField do
- CheckODBC(SQLBindCol(Handle,FPosition,FBufType,GetData,FBufSize,FBuffer+FBuffOffset)
- ,SErrBindCol);
-procedure TODBCStatement.ClearFields;
- FFields.Clear;
-constructor TODBCStatement.Create(Aowner: TComponent);
- FHandleType:=SQL_HANDLE_STMT;
- If AOwner is TODBCConnection then
- Connection:=TODBCConnection(Aowner);
- FFields:=TODBCFieldList.Create(Self);
-function TODBCStatement.ParentHandle: SQLHandle;
- If (Connection=Nil) then
- ODBCError(SErrNoConnectionForStatement);
- Result:=Connection.Handle;
-procedure TODBCStatement.SetConnection(const Value: TODBCConnection);
- If Value<>FConnection then
- FConnection := Value;
-Function TODBCStatement.fetch : Boolean;
- res : SQLReturn;
- Res:=SQLFetch(Handle);
- Result:=(Res=SQL_SUCCESS);
- If Not Result and (Res<>SQL_NO_DATA) then
- CheckODBC(Res,SErrFetchingData);
- FBof:=False;
- If (Res=SQL_NO_DATA) then
- FEOF:=True;
-destructor TODBCStatement.Destroy;
- FFields.Free;
-{ TODBCSQLStatement }
-procedure TODBCSQLStatement.GetFieldList(List : TStrings);
- if Not (FState in [ssPrepared,ssBound,ssOpen]) then
- ODBCError(SErrNotPrepared);
- List.Add(CName);
-procedure TODBCSQLStatement.Unprepare;
- Case FState of
- ssBound,ssOpen :
- ClearFields;
- FreeStatement(SQL_CLOSE);
- ssPrepared : begin
- FState:=ssInactive;
-procedure TODBCSQLStatement.FreeStatement(Option : SQLUSMALLINT);
- SQLFreeStmt(Handle,SQL_CLOSE);
-procedure TODBCSQLStatement.Close;
- if FState<>ssInactive then
- Unprepare;
-constructor TODBCSQLStatement.Create(Aowner: TComponent);
- FSQL:=TStringList.Create;
-destructor TODBCSQLStatement.Destroy;
- if FState=ssOpen then
- Close
- else If FState<>ssInactive then
-procedure TODBCSQLStatement.ExecSQL;
- ssPrepared,ssBound : ExecutePrepared;
- ssInactive : ExecuteDirect;
- Raise Exception.Create(SErrStatementActive)
-procedure TODBCSQLStatement.ExecuteDirect;
- ODBCError(SErrStatementActive);
- S:=SQL.Text;
- CheckODBC(SQLExecDirect(Handle,PChar(S),SQL_NTS),SErrExecuting);
-procedure TODBCSQLStatement.ExecutePrepared;
- if Not (FState in [ssPrepared,ssBound]) then
- CheckODBC(SQLExecute(Handle),SErrExecutingPrepared);
-function TODBCSQLStatement.GetActive: Boolean;
- Result:=(FState=ssOpen);
-procedure TODBCSQLStatement.Open;
- if (FState<>ssOpen) then
- Writeln('Preparing');
- If FState=ssInactive then
- Prepare;
- Writeln('Bind fields');
- if FState=ssPrepared then
- BindFields(Nil);
- Writeln('Executing');
- ExecSQL;
- Writeln('Fetching');
- If FState=ssBound then
- FState:=ssOpen;
- FBOF:=True;
-procedure TODBCSQLStatement.Prepare;
- If FState<>ssInactive then
- ODBCError(SErrNotInactive);
- If (FSQL.Count=0) then
- ODBCError(SErrNoSQLStatement);
- S:=FSQL.Text;
- CheckODBC(SQLPrepare(Handle,PChar(S),SQL_NTS),SErrPreparing);
- FState:=ssPrepared;
-procedure TODBCSQLStatement.SetActive(const Value: Boolean);
- Open
-procedure TODBCSQLStatement.SetSQL(const Value: TStrings);
-procedure TODBCSQLStatement.BindFields(RestrictList: TStrings);
- FState:=ssBound;
-procedure TODBCStatement.AllocBuffers;
- I,TotalSize,AddSize : Integer;
- TotalSize:=0;
- For i:=0 to FFields.Count-1 do
- With (FFields.Items[i] as TODBCField) do
- AddSize:=FBufSize;
- If FBufSize=-2 then // Blob.
- AddSize:=0
- else if FBufSize=-1 then
- AddSize:=FSize+1; // some Char variant.
- // Store offset temporarily in FData
- FBuffOffset:=TotalSize;
- Inc(TotalSize,AddSize+SizeOf(SQLinteger));
- FBuffer:=GetMem(TotalSize);
- FBuffer:=Self.FBuffer;
-{ TODBCTableList }
-procedure TODBCTableList.GetTableNames(S: TStrings; SystemTables : Boolean);
- TName,
- TType: array[0..SQL_NAME_LEN+1] of char;
- NL,TL: SQLINTEGER;
- Res: SQLRETURN;
- S.Clear;
- Res:=CheckODBC(SQLTables(handle, nil,0,nil,0,nil,0,nil,0),SErrGettingTableNames);
- if Res=SQL_SUCCESS then
- // Must bind by colno, because names changed between ODBC 2.0 and 3.0 !!
- SQLBindCol(handle,3,SQL_CHAR,@TName,SQL_NAME_LEN,@NL);
- SQLBindCol(handle,4,SQL_CHAR,@TType,SQL_NAME_LEN,@TL);
- While Fetch do
- if SystemTables or (CompareText(TType,'SYSTEM TABLE')<>0) then
- S.Add(TName);
-{ TODBCFieldNamesList }
-procedure TODBCFieldNamesList.GetFieldNames(TableName: String;
- FName : array[0..SQL_NAME_LEN+1] of char;
- NF : SQLINTEGER;
- Res:=CheckODBC(SQLColumns(handle, nil, 0, nil, 0, pchar(TableName), SQL_NTS, nil, 0),SErrFieldNames);
- SQLBindCol(handle, 4, SQL_CHAR, @FNAme, SQL_NAME_LEN, @NF);
- S.Add(FName);
-{ TODBCPrimaryKeyFieldsList }
-procedure TODBCPrimaryKeyFieldsList.GetPrimaryKeyFields(TableName: String;
- Res:=CheckODBC(SQLPrimaryKeys(handle, nil, 0, nil, 0, pchar(TableName), SQL_NTS),SErrPrimaryKeys);
-{ TODBCProcedureList }
-procedure TODBCProcedureList.GetProcedureList(S: TStrings);
- PName : array[0..SQL_NAME_LEN+1] of char;
- NP : SQLINTEGER;
- Res:=CheckODBC(SQLProcedures(handle, nil, 0, nil, 0, Nil, 0),SErrProcedureNames);
- SQLBindCol(handle, 3, SQL_CHAR, @PNAme, SQL_NAME_LEN, @NP);
- S.Add(PName);
-{ TODBCProcedureParams }
-procedure TODBCProcedureParams.GetProcedureParams(ProcName: String;
- NP,NT : SQLINTEGER;
- Ptype : SQLSmallInt;
- Res:=CheckODBC(SQLProcedureColumns(handle, nil, 0, nil, 0, PChar(ProcName),SQL_NTS,Nil, 0),SErrProcedureNames);
- SQLBindCol(handle, 4, SQL_CHAR, @PName, SQL_NAME_LEN, @NP);
- SQLBindCol(handle, 5, SQL_SMALLINT, @PType, SizeOf(SQLSmallInt), @NT);
- If TODBCParamType(PType) in ParamTypes then
-{ TODBCFieldList }
-constructor TODBCFieldList.Create(Statement: TODBCStatement);
- FStatement:=Statement;
- Inherited Create(TODBCField);
-{ TODBCField }
-function TODBCField.GetAsString: String;
- If IsNull then
- Result:=''
- Case FBufType of
- SQL_Smallint : Result:=IntToStr(PSQLSmallInt(Data)^);
- SQL_Integer : Result:=IntToStr(PSQLINTEGER(Data)^);
- SQL_BIT : Result:=IntToStr(PByte(Data)^);
- SQL_CHAR : Result:=StrPas(Data);
- SQL_DOUBLE : Result:=FloatToStr(GetAsDouble);
- SQL_DATE : result:=DateToStr(AsDateTime);
- SQL_TIME : Result:=TimeToStr(AsDateTime);
- SQL_TIMESTAMP : result:=datetimeToStr(AsDateTime);
- SQL_TYPE_DATE : result:=dateToStr(AsDateTime);
- SQL_TYPE_TIMESTAMP : result:=datetimeToStr(AsDateTime);
- SQL_TYPE_TIME : Result:=TimeToStr(AsDateTime);
- ODBCError(SErrInvalidConversion)
-function TODBCField.GetData : Pchar;
- Result:=FBuffer+FBuffOffset+SizeOf(SQLinteger);
-function TODBCField.GetIsNull : boolean;
- Result:=PSQLinteger(FBuffer+FBuffOffset)^=SQL_NULL_DATA;
-Function TODBCField.GetAsInteger : Integer;
- SQL_Smallint : Result:=PSQLSmallInt(Data)^;
- SQL_Integer : Result:=PSQLINTEGER(Data)^;
- SQL_BIT : Result:=PByte(Data)^;
- SQL_CHAR : Result:=StrToInt(GetAsString);
- SQL_DOUBLE : Result:=Round(GetAsDouble);
- SQL_DATE,
- SQL_TIME,
- SQL_TIMESTAMP,
- SQL_TYPE_DATE,
- SQL_TYPE_TIMESTAMP,
- SQL_TYPE_TIME : Result:=Round(AsDateTime);
-Function TODBCField.GetAsBoolean : Boolean;
- Result:=False
- SQL_Smallint : Result:=PSQLSmallInt(Data)^=0;
- SQL_Integer : Result:=PSQLINTEGER(Data)^=0;
- SQL_BIT : Result:=PBYTE(Data)^=0;
- SQL_CHAR : Result:=(StrToInt(GetAsString)=0);
- SQL_DOUBLE : Result:=Round(GetAsDouble)=0;
- SQL_TYPE_TIME : Result:=Round(AsDateTime)=0;
-Function TODBCField.GetAsDouble : Double;
- SQL_BIT : Result:=PBYTE(Data)^;
- SQL_CHAR : Result:=StrToFloat(GetAsString);
- SQL_DOUBLE : Result:=PSQLDOUBLE(GetData)^;
- SQL_TYPE_TIME : Result:=AsDateTime;
-function DateStructToDateTime( b:PSQL_DATE_STRUCT):TDateTime;
-function DateTimeToDateStruct( b:TDateTime):SQL_DATE_STRUCT;
-procedure DateTime2TimeStampStruct( var Value:SQL_TIMESTAMP_STRUCT; b:TDateTime);
-Function TODBCField.GetAsDateTime : TDateTime;
- SQL_DATE : Result:=DateStructToDateTime(PSQL_DATE_STRUCT(Data));
- SQL_TIME : Result:=TimeStructToDateTime(PSQL_TIME_STRUCT(Data));
- SQL_TIMESTAMP : Result:=TimeStampStructToDateTime(PSQL_TIMESTAMP_STRUCT(Data));
- SQL_TYPE_DATE : Result:=DateStructToDateTime(PSQL_DATE_STRUCT(Data));
- SQL_TYPE_TIMESTAMP : Result:=TimeStampStructToDateTime(PSQL_TIMESTAMP_STRUCT(Data));
- SQL_TYPE_TIME : Result:=TimeStructToDateTime(PSQL_TIME_STRUCT(Data));
-Finalization
- If Assigned(DefEnv) then
- TODBCEnvironment(DefEnv).Free;
@@ -1,63 +0,0 @@
-program testbcon;
- Test browsingconnection
- - I don't have a driver which supports it though :/
-uses fpodbc,Classes;
- TApp = Class (TObject)
- Conn : TODBCConnection;
- Procedure GetParams (Sender : TObject; ListIn,ListOut : TStrings);
- Procedure Run;
-{ TApp }
-procedure TApp.GetParams(Sender: TObject; ListIn, ListOut: TStrings);
- i : integer;
- Writeln('Input parameters were :');
- With ListIN do
- Writeln(Strings[i]);
- Writeln('Output parameters were :');
- With Listout do
- Writeln('Parameter to add to input (empty to quit):');
- Readln(S);
- ListIn.Add(S)
- Until S='';
-procedure TApp.Run;
- Conn:=TODBCConnection.Create(Nil);
- Conn.DSN:='FPC';
- Conn.OnBrowseConnection:[email protected];
- Conn.Active:=True;
- Writeln('Connected !!');
- Conn.Active:=False;
- Conn.free;
- With Tapp.Create do
-program testcon;
- Writeln('Disconnected again');
-program testdrcon;
- Conn.drivername:='Microsoft Access Driver (*.mdb)';
- Conn.DriverParams.Add('DBQ=d:\temp\odbc\testodbc.mdb');
- Writeln('Disconnected again.');
@@ -1,45 +0,0 @@
-program testenv;
- I,J : Integer;
- List,Options : TStringList;
- Env : TODBCEnvironment;
- UseDefault : Boolean;
- useDefault:=(ParamCount>0) and (Paramstr(1)='-d');
- If UseDefault then
- Env:=DefaultEnvironment
- Env:=TODBCEnvironment.Create(Nil);
- Writeln('Handle is : ',Env.Handle);
- List:=TStringlist.Create;
- Options:=TStringList.Create;
- Writeln('List of drivers :');
- Env.GetDriverNames(List);
- Writeln('Count : ',List.Count);
- For I:=0 to List.Count-1 do
- Writeln(i:2,' : ',List[i]);
- Writeln('List of driver options :');
- Env.GetDriverOptions(List[i],Options);
- Writeln('Options for driver ',List[i],' : ');
- For J:=0 to Options.Count-1 do
- Writeln(' ',Options[j]);
- Env.GetDataSourceNames(List,dtBoth,True);
- Writeln('List of datasource names : ');
- writeln(i,' : ',List[i]);
- List.free;
- options.Free;
- If not UseDefault then
- env.free;
-program testfl;
- FieldNames : TStringList;
- FieldNames:=TStringList.Create;
- FieldNames.Sorted:=True;
- Conn.GetFieldNames('FPDev',FieldNames);
- Writeln('Found ',FieldNames.Count,' Fields in table FPDev : ');
- For I:=0 to FieldNames.Count-1 do
- Writeln(FieldNames[i]);
- FieldNames.Free;
@@ -1,33 +0,0 @@
-program testpa;
- ProcedureParams : TStringList;
- PT : TODBCParamType;
- Conn.DSN:='BUGS';
- ProcedureParams:=TStringList.Create;
- ProcedureParams.Sorted:=True;
- For PT:=ptUnknown to ptRetval do
- Conn.GetProcedureParams('GET_BUGID',[Pt],ProcedureParams);
- Writeln('Found ',ProcedureParams.Count,' parameters of type ',ODBCParamTypeNames[Pt],' :');
- For I:=0 to ProcedureParams.Count-1 do
- Writeln(ProcedureParams[i]);
- ProcedureParams.Free;
-program testpl;
- PrimaryKeyFields : TStringList;
- PrimaryKeyFields:=TStringList.Create;
- PrimaryKeyFields.Sorted:=True;
- Conn.GetPrimaryKeyFields('BUGS',PrimaryKeyFields);
- Writeln('Found ',PrimaryKeyFields.Count,' primary key fields in table BUGS : ');
- For I:=0 to PrimaryKeyFields.Count-1 do
- Writeln(PrimaryKeyFields[i]);
- PrimaryKeyFields.Free;
-program testpr;
- ProcedureNames : TStringList;
- ProcedureNames:=TStringList.Create;
- ProcedureNames.Sorted:=True;
- Conn.GetProcedureNames(ProcedureNames);
- Writeln('Found ',ProcedureNames.Count,' procedures:');
- For I:=0 to ProcedureNames.Count-1 do
- Writeln(ProcedureNames[i]);
- ProcedureNames.Free;
@@ -1,102 +0,0 @@
-program testsql;
-uses fpodbc,Classes,odbcsql;
- St : TODBCSQLStatement;
- I,Count : Integer;
-procedure DumpFielddef(F : TODBCField);
- Writeln('Field ',F.Position,' : ',F.Name);
- Writeln('Type : ',F.DataType);
- Writeln('Size : ',F.Size);
- Writeln('Decimal digits : ',F.DecimalDigits);
- Writeln('Nullable : ',F.Nullable);
-procedure DumpField(F : TODBCField);
- Write(Name:12,BufType:5,' ');
- Writeln('(Null)')
- Case BufType of
- SQL_Smallint : Writeln(AsInteger);
- SQL_Integer : Writeln(AsInteger);
- SQL_BIT : Writeln(AsInteger);
- SQL_CHAR : Writeln(AsString);
- SQL_DOUBLE : Writeln(AsDouble);
- SQL_TYPE_TIME : Writeln(AsString);
- Writeln('Unknown field type');
- ST:=TODBCSQLStatement.Create(Conn);
- ST.SQL.Text:='Select * from fpdev order by id';
- Writeln('Opening');
- ST.Open;
- Writeln('Opened');
- st.GetFieldList(FieldNames);
- Writeln('Found ',FieldNames.Count,' Fields in result set :');
- Writeln(i+1,': ',FieldNames[i]);
- Writeln('End of list');
- Writeln('FieldDefs:');
- with st.fields do
- for I:=0 to COunt-1 do
- DumpFielddef(st.fields.items[i] as TODBCField);
- Writeln('Data dump:');
- While not st.eof do
- Writeln('Record no ',Count,' : ');
- Writeln('Name':12,'Type':5,' Value');
- for I:=0 to st.fields.COunt-1 do
- DumpField(st.fields.items[i] as TODBCField);
- st.fetch;
- Writeln('End of data');
- Writeln('Freed list');
- st.Close;
- Writeln('Closed');
- ST.Free;
- Writeln('Freed statement');
- Writeln('Disactivated connection');
- Writeln('Freed Connection');
@@ -1,62 +0,0 @@
-program testst;
- ST.SQL.Text:='Select * from fpdev';
- ST.Prepare;
- st.bindfields(nil);
- St.Unprepare;
- Writeln('Unprepared');
@@ -1,31 +0,0 @@
- TableNames : TStringList;
- TableNames:=TStringList.Create;
- TableNames.Sorted:=True;
- Conn.GetTableNames(TableNames,True);
- Writeln('Found ',TableNames.Count,' tables : ');
- For I:=0 to TableNames.Count-1 do
- Writeln(TableNames[i]);
- TableNames.Free;
@@ -1,2058 +0,0 @@
-override TARGET_UNITS+=sqlitedataset
-override REQUIRE_PACKAGES=rtl sqlite
-ifdef REQUIRE_PACKAGES_SQLITE
-PACKAGEDIR_SQLITE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /sqlite/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_SQLITE),)
-ifneq ($(wildcard $(PACKAGEDIR_SQLITE)/units/$(TARGETSUFFIX)),)
-UNITDIR_SQLITE=$(PACKAGEDIR_SQLITE)/units/$(TARGETSUFFIX)
-UNITDIR_SQLITE=$(PACKAGEDIR_SQLITE)
-$(PACKAGEDIR_SQLITE)/$(FPCMADE):
- $(MAKE) -C $(PACKAGEDIR_SQLITE) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_SQLITE)/$(FPCMADE)
-PACKAGEDIR_SQLITE=
-UNITDIR_SQLITE:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /sqlite/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_SQLITE),)
-UNITDIR_SQLITE:=$(firstword $(UNITDIR_SQLITE))
-UNITDIR_SQLITE=
-ifdef UNITDIR_SQLITE
-override COMPILER_UNITDIR+=$(UNITDIR_SQLITE)
@@ -1,24 +0,0 @@
-# Makefile.fpc for sqlite FCL db units
-units=sqlitedataset
-packages=sqlite
@@ -1,1301 +0,0 @@
-unit SQLiteDataset;
-Improved class sqLite,copyright(c) 2002-2003 Marcin Krzetowski
-http://www.a-i.prv.pl
-simple class interface for SQLite. Hacked in by Ben Hochstrasser ([email protected])
-Thanks to Roger Reghin ([email protected]) for his idea to ValueList.
- Classes,db,sysutils,Contnrs;
- PRecInfo = ^TRecInfo;
- TRecInfo = record
- Index: Integer;
- Bookmark: Longint;
- pBinBookMark = ^tBinBookMark;
- tBinBookmark = record
- RecPtr : Int64;
- TSQLiteExecCallback = function(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer of object; cdecl;
- TSQLiteBusyCallback = function(Sender: TObject; ObjectName: PChar; BusyCount: integer): integer of object; cdecl;
- TOnData = Procedure(Sender: TObject; Columns: Integer; ColumnNames, ColumnValues: String) of object;
- TOnBusy = Procedure(Sender: TObject; ObjectName: String; BusyCount: integer; var Cancel: Boolean) of object;
- TOnQueryComplete = Procedure(Sender: TObject) of object;
- tSqliteField = class(tObject)
-protected
- FOwner : tObject;
- data : string;
- fFieldKind: tFieldKind;
- fFieldType: tFieldType;
-{ tIntegerType : Integer;
- tLongIntegerType : int64;
- tDateTimeType : tDateTime;}
-// procedure SetName(const Value: string);
- procedure SetFieldKind(const Value: tFieldKind);
- procedure SetFieldType(const Value: tFieldType);
-public
- constructor create(aOwner : tObject);
- destructor destroy; override;
- procedure SetData(pt : pChar; NativeFormat : boolean);
- function GetData(Buffer: Pointer; NativeFormat : Boolean) : boolean;
- function GetData(Buffer: Pointer{=True}) : boolean;
-// property FieldName : string read fName write SetName;
- property FieldKind : tFieldKind read fFieldKind write SetFieldKind;
- property FieldType : tFieldType read fFieldType write SetFieldType;
-tSqliteRows = class (tObject)
-private
- function getItem(index: integer): tSqliteField;
- procedure SetItem(index: integer; const Value: tSqliteField);
- function checkIndex(index : integer) : boolean;
- BookmarkFlag : tBookmarkFlag;
- Bookmark : LongInt;
- DataPointer : Pointer;
- constructor Create(fieldCount : integer);
- procedure Push(item : tSqliteField);
- function Pop : tSqliteField;
- property Items[index : integer] : tSqliteField read getItem write SetItem;
- procedure Clear;
- procedure ClearCalcFields;
- function add(pt : Pchar; ptName : pCHar) : boolean;
- fbuffercount : integer;
- fBuffer : ^tSqliteField;
- internalCount : integer;
- procedure clearBuffer;
- TSQLite = class(TDataSet)
- maxLengthInit : boolean;
- maxiL : pinteger;
- maxilcount : integer;
- fDoExceptions : boolean;
- fDoSQL : boolean;
- fIsCancel: boolean;
- fSQLite: Pointer;
- fMsg: String;
- fIsOpen: Boolean;
- fBusy: Boolean;
- fError: Integer;
- fVersion: String;
- fEncoding: String;
- fTable: tStrings;
- fLstName: TStringList;
- fLstVal: TStringList;
-// fbuffer : tObjectList;
- fOnData: TOnData;
- fOnBusy: TOnBusy;
- fOnQueryComplete: TOnQueryComplete;
- fBusyTimeout: integer;
- fPMsg: PChar;
- fChangeCount: integer;
- fSQL: tStringlist;
- fonwer : tComponent;
- fDataBaseName : string;
- fDataBase: string;
- fTableName: string;
- factive : boolean;
- procedure SetBusyTimeout(Timeout: integer);
- procedure SetDataBase(DBFileName: String);
- procedure setTableName(const Value: string);
- function getIsCancel: boolean;
- fCalcFieldsOfs,fRecordSize : integer;
- fBookMarkOfs,fRecordBufferSize : integer;
- fCurrentRecord : int64;
- fRecordCount : int64;
- fCursorOpen : boolean;
- fFieldOffset : tList;
- // procedure internalInsert; override;
- function getActive: boolean;
- // procedure setActive(Value: boolean); override;
- function getRecNo : integer; override;
- function getBookmarkFlag(Buffer : pChar) : tBookMarkFlag; override;
- procedure InitBufferPointers;
- procedure GetBookmarkData(Buffer : pChar; Data : Pointer); override;
- procedure SetBookMarkData(Buffer : pChar; Data : Pointer); override;
- procedure InternalGotoBookmark(ABookMark : Pointer) ; override;
- function FieldDefsStored : boolean;
- procedure ClearCalcFields(Buffer : pChar); override;
- procedure OpenCursor(InfoQuery : Boolean); override;
- function getRecordCount : integer; override;
- procedure SetRecNo (value : integer); override;
- function getRecord(Buffer : pChar; GetMode : tGetMode; DoCheck : Boolean): tGetResult; override;
- procedure InternalAddRecord(Buffer : Pointer; DoAppend : boolean); override;
- procedure InternalInitRecord(Buffer : pChar); override;
- procedure InternalLast;override;
- procedure InternalPost;override;
- procedure InternalSetToRecord (Buffer : pChar); override;
- function isCursorOpen : Boolean; override;
- procedure SetBookmarkFlag(Buffer : pChar; value : tBookmarkFlag); override;
- procedure SetFieldData(Field : tField; Buffer : Pointer); override;
- function allocRecordBuffer : pChar; override;
- procedure FreeRecordBuffer(var Buffer : pChar); override;
- function getRecordSize : Word; override;
- function getCanModify : boolean; override;
- fbuffer : tObjectList; //po zakonczeniu debuggowania usunac
- constructor create(Aowner : tComponent); override;
- function getFieldData(Field : tField; Buffer : Pointer) : boolean; override;
- function Query(ASql: String{table= nil}) : Boolean;
- Function Query(ASQL: String; Table: TStrings): boolean;
- function ExecSQL : boolean;
- function ErrorMessage(ErrNo: Integer): string;
- function IsComplete(ASql: String): boolean;
- function LastInsertRow: integer;
- procedure Cancel; override;
- function DatabaseDetails(Table: TStrings): boolean;
- function CreateTable : boolean;
- procedure countMaxiLength(pt: pChar;index : int64);
- procedure InitMaxLength(length : integer);
- property LastErrorMessage: string read fMsg;
- property LastError: Integer 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: Integer read fBusyTimeout write SetBusyTimeout;
- property ChangeCount: Integer read fChangeCount;
- property SQL : tStringlist read fSQL write fSQL;
-// property Fields : tstringlist read fFields;
- property DataBase : string read fDataBase write SetDataBase;
- property TableName : string read fTableName write setTableName;
- property Active : boolean read getActive write setActive;
- property isCancel : boolean read getIsCancel;
- property DoExceptions : boolean read fDoExceptions write fDoExceptions stored true default true;
- 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;
- function QuoteStr(const s: string{; QuoteChar: Char = #39}): string;
- function UnQuoteStr(const s: string{; QuoteChar: Char = #39}): string;
- procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
- procedure Register;
-{$ifndef dynload}
-uses sqlite;
-{$else}
-uses dynlibs;
-function GetProcAddress(S : String) : Pointer;
- SQLITE_OK = 0; // Successful result
- SQLITE_ERROR = 1; // SQL error or missing database
- SQLITE_INTERNAL = 2; // An internal logic error in SQLite
- SQLITE_PERM = 3; // Access permission denied
- SQLITE_ABORT = 4; // Callback routine requested an abort
- SQLITE_BUSY = 5; // The database file is locked
- SQLITE_LOCKED = 6; // A table in the database is locked
- SQLITE_NOMEM = 7; // A malloc() failed
- SQLITE_READONLY = 8; // Attempt to write a readonly database
- SQLITE_INTERRUPT = 9; // Operation terminated by sqlite_interrupt()
- SQLITE_IOERR = 10; // Some kind of disk I/O error occurred
- SQLITE_CORRUPT = 11; // The database disk image is malformed
- SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found
- SQLITE_FULL = 13; // Insertion failed because database is full
- SQLITE_CANTOPEN = 14; // Unable to open the database file
- SQLITE_PROTOCOL = 15; // Database lock protocol error
- SQLITE_EMPTY = 16; // (Internal Only) Database table is empty
- SQLITE_SCHEMA = 17; // The database schema changed
- SQLITE_TOOBIG = 18; // Too much data for one row of a table
- SQLITE_CONSTRAINT = 19; // Abort due to contraint violation
- SQLITE_MISMATCH = 20; // Data type mismatch
- SQLITEDLL: PChar = 'sqlite.dll';
- DblQuote: Char = '"';
- SngQuote: Char = #39;
- Crlf: String = #13#10;
- Tab: Char = #9;
- _DO_EXCEPTIONS = 1; //Handle or not exceptions in dataset
-{$ifdef dynload}
- SQLite_Open: function(dbname: PChar; mode: Integer; var ErrMsg: PChar): Pointer; cdecl;
- SQLite_Close: procedure(db: Pointer); cdecl;
- SQLite_Exec: function(db: Pointer; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl;
- SQLite_Version: function(): PChar; cdecl;
- SQLite_Encoding: function(): PChar; cdecl;
- SQLite_ErrorString: function(ErrNo: Integer): PChar; cdecl;
- SQLite_GetTable: function(db: Pointer; SQLStatement: PChar; var ResultPtr: Pointer; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl;
- SQLite_FreeTable: procedure(Table: PChar); cdecl;
- SQLite_FreeMem: procedure(P: PChar); cdecl;
- SQLite_Complete: function(P: PChar): boolean; cdecl;
- SQLite_LastInsertRow: function(db: Pointer): integer; cdecl;
- SQLite_Cancel: procedure(db: Pointer); cdecl;
- SQLite_BusyHandler: procedure(db: Pointer; CallbackPtr: Pointer; Sender: TObject); cdecl;
- SQLite_BusyTimeout: procedure(db: Pointer; TimeOut: integer); cdecl;
- SQLite_Changes: function(db: Pointer): integer; cdecl;
- LibsLoaded: Boolean;
- DLLHandle: THandle;
- MsgNoError: String;
-function QuoteStr(const s: string): string;
- Result := QuoteStr(S,#39);
-function QuoteStr(const s: string; QuoteChar: Char): string;
- Result := Concat(QuoteChar, s, QuoteChar);
-function UnQuoteStr(const s: string): string;
- Result := UnQuoteStr(s,#39);
-function UnQuoteStr(const s: string; QuoteChar: Char): string;
- Result := s;
- if length(Result) > 1 then
- if Result[1] = QuoteChar then
- Delete(Result, 1, 1);
- if Result[Length(Result)] = QuoteChar then
- Delete(Result, Length(Result), 1);
-function Pas2SQLStr(const PasString: string): string;
- n: integer;
- Result := SQL2PasStr(PasString);
- n := Length(Result);
- while n > 0 do
- if Result[n] = SngQuote then
- Insert(SngQuote, Result, n);
- dec(n);
- Result := QuoteStr(Result);
-function SQL2PasStr(const SQLString: string): string;
- DblSngQuote: String = #39#39;
- p: integer;
- Result := SQLString;
- p := pos(DblSngQuote, Result);
- while p > 0 do
- Delete(Result, p, 1);
- Result := UnQuoteStr(Result);
-procedure ValueList(const ColumnNames, ColumnValues: String; NameValuePairs: TStrings);
- lstName, lstValue: TStringList;
- if NameValuePairs <> nil then
- 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;
-function LoadLibs: Boolean;
- DLLHandle := LoadLibrary(SQLITEDLL);
- if DLLHandle <> 0 then
- @SQLite_Open := GetProcAddress(DLLHandle, 'sqlite_open');
- if not Assigned(@SQLite_Open) then exit;
- @SQLite_Close := GetProcAddress(DLLHandle, 'sqlite_close');
- if not Assigned(@SQLite_Close) then exit;
- @SQLite_Exec := GetProcAddress(DLLHandle, 'sqlite_exec');
- if not Assigned(@SQLite_Exec) then exit;
- @SQLite_Version := GetProcAddress(DLLHandle, 'sqlite_libversion');
- if not Assigned(@SQLite_Version) then exit;
- @SQLite_Encoding := GetProcAddress(DLLHandle, 'sqlite_libencoding');
- if not Assigned(@SQLite_Encoding) then exit;
- @SQLite_ErrorString := GetProcAddress(DLLHandle, 'sqlite_error_string');
- if not Assigned(@SQLite_ErrorString) then exit;
- @SQLite_GetTable := GetProcAddress(DLLHandle, 'sqlite_get_table');
- if not Assigned(@SQLite_GetTable) then exit;
- @SQLite_FreeTable := GetProcAddress(DLLHandle, 'sqlite_free_table');
- if not Assigned(@SQLite_FreeTable) then exit;
- @SQLite_FreeMem := GetProcAddress(DLLHandle, 'sqlite_freemem');
- if not Assigned(@SQLite_FreeMem) then exit;
- @SQLite_Complete := GetProcAddress(DLLHandle, 'sqlite_complete');
- if not Assigned(@SQLite_Complete) then exit;
- @SQLite_LastInsertRow := GetProcAddress(DLLHandle, 'sqlite_last_insert_rowid');
- if not Assigned(@SQLite_LastInsertRow) then exit;
- @SQLite_Cancel := GetProcAddress(DLLHandle, 'sqlite_interrupt');
- if not Assigned(@SQLite_Cancel) then exit;
- @SQLite_BusyTimeout := GetProcAddress(DLLHandle, 'sqlite_busy_timeout');
- if not Assigned(@SQLite_BusyTimeout) then exit;
- @SQLite_BusyHandler := GetProcAddress(DLLHandle, 'sqlite_busy_handler');
- if not Assigned(@SQLite_BusyHandler) then exit;
- @SQLite_Changes := GetProcAddress(DLLHandle, 'sqlite_changes');
- if not Assigned(@SQLite_Changes) then exit;
-function SystemErrorMsg(ErrNo: Integer): String;
- buf: PChar;
- size: Integer;
- MsgLen: Integer;
-{ msglen:=0;
- 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'
- Result := buf;
- Result := ('SystemErrorMsg Not Implemented');
-function SystemErrorMsg: String;
- SystemErrorMsg(-1);
-function BusyCallback(Sender: Pointer; ObjectName: PChar; BusyCount: integer): integer; cdecl;
- sObjName: String;
- bCancel: Boolean;
- Result := -1;
- with TSQLite(Sender) do
- if Assigned(fOnBusy) then
- bCancel := False;
- sObjName := ObjectName;
- fOnBusy(Tsqlite(Sender), sObjName, BusyCount, bCancel);
- if bCancel then
-function ExecCallback(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer; cdecl;
- PVal, PName: ^PChar;
- sVal, sName: String;
- with Sender as TSQLite do
- if (Assigned(fOnData) or Assigned(fTable)) then
- fLstName.Clear;
- fLstVal.Clear;
- if Columns > 0 then
- PName := ColumnNames;
- PVal := ColumnValues;
- for n := 0 to Columns - 1 do
- fLstName.Append(PName^);
- fLstVal.Append(PVal^);
- if Assigned(fTable) then
- fTable.Append(PVal^);
- inc(PName);
- inc(PVal);
- sVal := fLstVal.CommaText;
- sName := fLstName.CommaText;
- if Assigned(fOnData) then
- fOnData(Sender, Columns, sName, sVal);
-// InternalOpen;
-function ExecCallback2(Sender: TObject; Columns: Integer; ColumnValues: Pointer; ColumnNames: Pointer): integer; cdecl;
- t : tSqliteRows;
- p : pointer;
- temp : LongInt;
- with Sender as TSQLite do begin
- if (Assigned(fOnData) or assigned(fBuffer)) then begin
-// fLstVal.Clear;
- if Columns > 0 then begin
- fBuffer.Add(tSqliteRows.Create(Columns));
- temp:=fBuffer.count-1;
- initMaxLength(columns);
- for n := 0 to Columns - 1 do begin
- if Assigned(fBuffer) then begin
- p:=fBuffer.Items[temp];
- t:=tSqliteRows(p);
- if t=nil then continue;
- t.Add(PVAL^,PNAME^);
- countMaxiLength(PVAL^,n);
- // at last we add the bookmark info
- t.Bookmark:=temp;
- if Assigned(fOnData) then begin
-procedure TSQLite.SetDataBase(DBFileName: String);
- afPMsg: PChar;
- fError := SQLITE_ERROR;
- fIsOpen := False;
- fOnData := nil;
- fOnBusy := nil;
- fOnQueryComplete := nil;
- fChangeCount := 0;
- if LibsLoaded then
- fSQLite := SQLite_Open(PChar(DBFileName), 1, @afPMsg);
- SQLite_FreeMem(afPMsg);
- if fSQLite <> nil then
- {$ifndef fpc}
- fVersion := strpas(SQLite_Version);
- fEncoding := strpas(SQLite_Encoding);
- fIsOpen := True;
- fError := SQLITE_OK;
- fMsg := ErrorMessage(fError);
-destructor TSQLite.Destroy;
-try
-if assigned(fSQl) then begin
- fsql.free;
- fsql:=nil;
- if fIsOpen then
- SQLite_Close(fSQLite);
-if assigned(fLstName) then begin
- fLstName.Free;
- fLstName:=nil;
-if assigned(fLstVal) then begin
- fLstVal.Free;
- fLstVal:=nil;
- fSQLite := nil;
- fLstName := nil;
- fLstVal := nil;
-if assigned(fBuffer) then begin
- clearBuffer;
- fBuffer.Free;
- fBuffer:=nil;
-except
-function TSQLite.Query(ASql: String): boolean;
- Result:=Query(ASql,Nil);
-function TSQLite.Query(ASql: String; Table: TStrings): boolean;
-//var
-// fPMsg: PChar;
- maxLengthInit:=false;
- fPMsg := nil;
- fBusy := True;
- fTable := Table;
- if fTable <> nil then
- fTable.Clear;
- fError := SQLite_Exec(fSQLite, PChar(ASql), @ExecCallback, Self, @fPMsg);
- SQLite_FreeMem(fPMsg);
- fChangeCount := SQLite_Changes(fSQLite);
- fTable := nil;
- fBusy := False;
- if Assigned(fOnQueryComplete) then
- fOnQueryComplete(Self);
- Result := not (fError <> SQLITE_OK);//function should return true, if execution of query ends ok..
- if result and not active then
- factive:=true;
- fDoSql:=true;
-procedure TSQLite.SetBusyTimeout(Timeout: Integer);
- fBusyTimeout := Timeout;
- SQLite_Busy_Timeout(fSQLite, fBusyTimeout);
- if fBusyTimeout > 0 then
- SQLite_Busy_Handler(fSQLite, @BusyCallback, Self)
- SQLite_Busy_Handler(fSQLite, nil, nil);
-function TSQLite.LastInsertRow: integer;
- Result := SQLite_Last_Insert_Rowid(fSQLite)
-function TSQLite.ErrorMessage(ErrNo: Integer): string;
- if ErrNo = 0 then
- Result := MsgNoError
- Result := SQLite_Error_String(ErrNo);
- end else
- Raise exception.Create('Library "sqlite.dll" not found.');
-function TSQLite.IsComplete(ASql: String): boolean;
- Result := SQLite_Complete(PChar(ASql))=0;
-function TSQLite.DatabaseDetails(Table: TStrings): boolean;
- Result := Query('SELECT * FROM SQLITE_MASTER;', Table);
-function TSQLite.ExecSQL: boolean;
-var i : integer;
- result:=false;
- for i:=0 to fsql.Count-1 do begin
- fError := SQLite_Exec(fSQLite, PChar(fSql[i]), @ExecCallback2, Self, @fPMsg);
- Result :=not (fError <> SQLITE_OK);
- fDoSQl:=true;
-constructor TSQLite.Create(Aowner: tComponent);
-inherited create(Aowner);
-fLstName := TStringList.Create;
-fLstVal := TStringList.Create;
-fDoSql:=false;
-fsql:=tStringList.Create;
-fOnwer:=owner;
-fBuffer:=tObjectList.Create(true);
-if length(fDataBase)>1 then
- setDataBase(fDataBase);
-procedure TSQLite.setTableName(const Value: string);
-if (not active) and (length(value)>0) then begin
- fTableName := Value;
- sql.Clear;
- sql.add('select rowid,* from '+tableName+';');
-function TSQLite.getActive: boolean;
-result:=fActive;
-procedure TSQLite.setActive(Value: boolean);
- if value then
- //switch for active=true;
- if active then
- active:=false;
- fDoSQL:=value;
- inherited setActive(value);
-function TSQLite.getRecNo: integer;
-result:=self.fCurrentRecord;
-procedure TSQLite.Cancel;
- fIsCancel := False;
- if fBusy and fIsOpen then
- do_SQLite_interrupt(fSQLite);
- fBusy := false;
- fIsCancel := True;
-function TSQLite.getIsCancel: boolean;
-function TSQLite.getBookmarkFlag(Buffer: pChar): tBookMarkFlag;
-result:= pRecInfo(Buffer)^.BookmarkFlag;
-procedure TSQLite.InitBufferPointers;
-fCalcFieldsOfs :=fRecordSize;
-//fRecInfoOfs :=fCalcFieldsOfs + CalcFieldsSize;
-//fBookMarkOfs := fRecInfoOfs+SizeOf(tRecInfo);
-fRecordBufferSize :=fBookmarkOfs + BookmarkSize;
-procedure TSQLite.GetBookmarkData(Buffer: pChar; Data: Pointer);
-Move(Buffer[fBookMarkOfs],Data^,SizeOf(tBinBookMark));
-//implementacja jest watpliwa
-procedure TSQLite.SetBookMarkData(Buffer: pChar; Data: Pointer);
-Move(Data^,Buffer[fBookMarkOfs],SizeOf(tbinBookMark));
-procedure TSQLite.InternalGotoBookmark(ABookMark: Pointer);
-with pBinBookMark(ABookMark)^ do begin
- fCurrentRecord :=RecPtr;
-function TSQLite.FieldDefsStored: boolean;
-procedure TSQLite.ClearCalcFields(Buffer: pChar);
-var p : pointer;
-t : tSQliteRows;
-inherited;
-p:=buffer;
-if p<>nil then begin
- t:=tSQliteRows(p);
- t.clearCalcFields;
-function TSQLite.getRecordCount: integer;
-result :=fRecordCount;
-procedure TSQLite.OpenCursor(InfoQuery: Boolean);
-procedure TSQLite.SetRecNo(value: integer);
-function TSQLite.CreateTable: boolean;
-function TSQLite.getRecord(Buffer: pChar; GetMode: tGetMode;
- DoCheck: Boolean): tGetResult;
-if fRecordCount<1 then
- result:=grEof
-else begin
- result:=grOk;
- Case GetMode of
- if fCurrentRecord>= (fRecordCount-1) then
- Inc(fCurrentRecord);
- if (fCurrentRecord <=0) then
- result:=grBof
- Dec(fCurrentRecord);
- if (fCurrentRecord >= fRecordCount) or (fCurrentRecord <0) then
- result:=grError;
-if result=grOk then begin
- self.fRecordBufferSize:=sizeOf(fBuffer[fCurrentRecord]);
- self.fRecordSize:=self.fRecordBufferSize;
- // Buffer:=fBuffer.List[fcurrentRecord];
- //read data from psyh buffer sqlite..;)
- GetCalcFields(Buffer);
- { with fBuffer.Items[fCurrentRecord] as tSqliteRows do begin
- end;}
- with PRecInfo(Buffer)^ do
- Index := fCurrentRecord;
- Bookmark := Integer (fCurrentRecord);
-if result=grError then begin
- if DoCheck and DoExceptions then
- raise edataBaseError.Create('Invalid Record');
-procedure TSQLite.InternalInitFieldDefs;
-FieldDefs.Clear;
-for i:=0 to fLstname.Count-1 do begin
- FieldDefs.Add(fLstName[i],ftString,MaxiL[i],false);
-procedure TSQLite.InternalOpen;
-if fBUffer<>nil then begin
-if (length(tableName)>0) and (fSQL.Count<1) then begin
- fsql.add('select rowid,* from '+fTableName);
-if not fDoSQL then
- fActive:=execSQL;
-InternalInitFieldDefs;
-if ((fLstName.count-1)>0) and (fBuffer<>nil) then
- fRecordCount:=(fBuffer.Count-1) div (fLstName.Count-1)
- fRecordCount:=0;
-if (fBuffer<>nil) then
- fRecordCount:=(fBuffer.Count-1)
-if DefaultFields then
-BindFields(true);
-FisOpen:=true;
- FRecordSize := sizeof (TRecInfo);
- BookmarkSize := sizeOf (Integer);
-procedure TSQLite.InternalClose;
-clearBuffer;
-function TSQLite.allocRecordBuffer: pChar;
-//now is time to calculate currentRecordSize...
- GetMem(Result,GetRecordSize);
- FillChar(Result^,GetRecordSize,0);
-procedure TSQLite.FreeRecordBuffer(var Buffer: pChar);
-//FreeMem(Buffer,sizeOf(Buffer));
-FreeMem(Buffer,GetRecordSize);
-function TSQLite.getRecordSize: Word;
- Result:=sizeof(TRecInfo);
-procedure TSQLite.InternalAddRecord(Buffer: Pointer; DoAppend: boolean);
-procedure TSQLite.InternalDelete;
-procedure TSQLite.InternalFirst;
- self.fCurrentRecord:=0;
-procedure TSQLite.InternalInitRecord(Buffer: pChar);
-procedure TSQLite.InternalLast;
- fCurrentRecord:=fRecordCount;
-procedure TSQLite.InternalPost;
-procedure TSQLite.InternalSetToRecord(Buffer: pChar);
-function TSQLite.isCursorOpen: Boolean;
-procedure TSQLite.SetFieldData(Field: tField; Buffer: Pointer);
-// var aa : string;
-// Does NOthing ??
-// aa:=Field.NewValue;
-// inherited;
-procedure TSQLite.SetBookmarkFlag(Buffer: pChar; value: tBookmarkFlag);
-function TSQLite.getFieldData(Field: tField; Buffer: Pointer): boolean;
-var i,k : integer;
-p : tSqliteField;
-r : tSqliteRows;
-pt : pointer;
-result:=false;
-k:=fieldDefs.Count-1;
-self.fLstName.Count;
-r:=fBuffer[PRecInfo(ActiveBuffer)^.Index] as tSqliteRows;
-if r=nil then exit;
-for i:=0 to k do begin
- if lowercase(fLstName[i])=lowercase(field.FieldName) then begin
- p:=r.items[i];
- if p = nil then break;
- p.GetData(Buffer,true);
- result:=true;
-{ tSqliteRows }
-procedure tSqliteRows.Push(item: tSqliteField);
-if internalcount<fBuffercount then begin
- fBuffer[internalCount]:=item;
- inc(internalCount);
-constructor tSqliteRows.Create(fieldCount: integer);
-inherited create;
-if fieldCount<=0 then
- fieldCount:=1;
- fbuffercount:=fieldcount+1;
-getmem(fBuffer,fbuffercount*sizeof(pointer));
-destructor tSqliteRows.destroy;
-function tSqliteRows.Pop: tSqliteField;
-result:=nil;
-if (internalCount>0) and (internalCount<fBuffercount) then begin
- result:=fBuffer[internalCount];
- Dec(internalCount);
-function tSqliteRows.getItem(index: integer): tSqliteField;
-if checkIndex(index) then
- result:=fBuffer[Index];
-procedure tSqliteRows.SetItem(index: integer; const Value: tSqliteField);
- fBuffer[index]:=Value;
-function tSqliteRows.checkIndex(index : integer): boolean;
-if (index>=0) and (index<internalCount) then
-procedure tSqliteRows.clearBuffer;
-if internalcount>0 then begin
-for i:=0 to internalCount -1 do begin
- if fBuffer[i]<>nil then begin
- fBuffer[i].Free;
- fBuffer[i]:=nil;
- continue;
-fbuffercount:=0;
-FreeMem(fBuffer);
-procedure tSqliteRows.Clear;
-internalCount:=0;
-procedure tSqliteRows.ClearCalcFields;
-function tSqliteRows.Add(pt: pChar;ptName : pChar):boolean;
-var tmp : int64;
-Push(tSqliteField.Create(nil));
-tmp:=internalCount-1;
-items[tmp].FieldKind:=fkData;
-items[tmp].SetFieldType(ftString);
-items[tmp].SetData(pt,true);
-procedure tSqlite.countMaxiLength(pt: pChar; index : int64);
-if length(pt)>maxil[index] then
- maxiL[index]:=length(pt);
-{ tSqliteField }
-constructor tSqliteField.create(aOwner: tObject);
-fOwner:=aOwner;
-destructor tSqliteField.destroy;
-function tSqliteField.GetData(Buffer: Pointer) : boolean;
- Result:=GetData(Buffer,True);
-end ;
-function tSqliteField.GetData(Buffer: Pointer;
- NativeFormat: Boolean): boolean;
- var
- l,tIntegerType : integer;
- tDateTimeType : tDateTime;
-if not nativeFormat then begin
- Move(data,Buffer^,sizeOf(data));
-end else begin
- case self.fieldType of
- ftInteger : begin
- tIntegerType:=StrToInt(data);
- Move(tIntegerType,Buffer^,sizeOf(data));
- ftDateTime : begin
- tDateTimeType:=StrToDate(data);
- Move(tDateTimeType,Buffer^,sizeOf(data));
- ftString : begin
- // L:=length(data);
- // Move(data,Buffer^,l);
- StrCopy (Buffer, pchar(data));
- Buffer:=nil;
-procedure tSqliteField.SetData(pt: pChar; NativeFormat: boolean);
-data:=pt;
-procedure tSqliteField.SetFieldKind(const Value: tFieldKind);
- fFieldKind := Value;
-procedure tSqliteField.SetFieldType(const Value: tFieldType);
- fFieldType := Value;
-procedure tSqliteField.SetName(const Value: string);
- fName := Value;
-function TSQLite.getCanModify: boolean;
-exit;//temporary
-if length(fTableName)>0 then
-procedure TSQLite.InitMaxLength(length: integer);
-if not maxLengthInit and (length>0) then begin
- maxLengthInit:=true;
- maxilcount:=length;
- getmem(maxiL,maxilcount*sizeof(integer));
-procedure TSQLite.clearBuffer;
- if fBuffer.count>0 then begin
- fBuffer.pack;
- fBuffer.clear;
-procedure TSQLite.internalInsert;
- if not getCanModify then exit;
-procedure Register;
- RegisterComponents('MK', [tSqlite]);
-initialization
- LibsLoaded := LoadLibs;
-{$ifdef fpc}
- MsgNoError := SystemErrorMsg(0);
- MsgNoError := 'The operation completed successfully';
-finalization
- FreeLibrary(DLLHandle);