Browse Source

+ Initial implementation in FCL

michael 25 years ago
parent
commit
80a5033038

+ 2 - 0
fcl/db/interbase/BUGS.known

@@ -0,0 +1,2 @@
+  * TDateTime field interpretation
+  * Some problems with TIBDataset.Close (fields)

+ 1218 - 0
fcl/db/interbase/Makefile

@@ -0,0 +1,1218 @@
+#
+# Makefile generated by fpcmake v0.99.15 [2000/05/10]
+#
+
+defaultrule: all
+
+#####################################################################
+# Autodetect OS (Linux or Dos or Windows NT)
+# define inlinux when running under linux
+# define inWinNT when running under WinNT
+#####################################################################
+
+# We need only / in the path
+override PATH:=$(subst \,/,$(PATH))
+
+# Search for PWD and determine also if we are under linux
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+ifeq ($(PWD),)
+nopwd:
+	@echo You need the GNU utils package to use this Makefile!
+	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
+	@exit
+else
+inlinux=1
+endif
+else
+PWD:=$(firstword $(PWD))
+endif
+
+# Detect NT - NT sets OS to Windows_NT
+ifndef inlinux
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+endif
+endif
+
+# Detect OS/2 - OS/2 has OS2_SHELL defined
+ifndef inlinux
+ifndef inWinNT
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+endif
+
+# The extension of executables
+ifdef inlinux
+EXEEXT=
+else
+EXEEXT=.exe
+endif
+
+# The path which is searched separated by spaces
+ifdef inlinux
+SEARCHPATH=$(subst :, ,$(PATH))
+else
+SEARCHPATH=$(subst ;, ,$(PATH))
+endif
+
+# Base dir
+ifdef PWD
+BASEDIR:=$(shell $(PWD))
+else
+BASEDIR=.
+endif
+
+#####################################################################
+# Default target
+#####################################################################
+
+override CPU_TARGET:=i386
+
+#####################################################################
+# FPC version/target Detection
+#####################################################################
+
+# What compiler to use ?
+ifndef FPC
+# Compatibility with old makefiles
+ifdef PP
+FPC=$(PP)
+else
+ifdef inOS2
+FPC=ppos2
+else
+FPC=ppc386
+endif
+endif
+endif
+override FPC:=$(subst $(EXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(EXEEXT)
+
+# Target OS
+ifndef OS_TARGET
+OS_TARGET:=$(shell $(FPC) -iTO)
+endif
+
+# Source OS
+ifndef OS_SOURCE
+OS_SOURCE:=$(shell $(FPC) -iSO)
+endif
+
+# Target CPU
+ifndef CPU_TARGET
+CPU_TARGET:=$(shell $(FPC) -iTP)
+endif
+
+# Source CPU
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(shell $(FPC) -iSP)
+endif
+
+# FPC version
+ifndef FPC_VERSION
+FPC_VERSION:=$(shell $(FPC) -iV)
+endif
+
+export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
+
+#####################################################################
+# FPCDIR Setting
+#####################################################################
+
+# Test FPCDIR to look if the RTL dir exists
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+else
+override FPCDIR=wrong
+endif
+
+# Default FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR=../..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=wrong
+endif
+endif
+endif
+
+# Detect FPCDIR
+ifeq ($(FPCDIR),wrong)
+ifdef inlinux
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(FPCDIR)/rtl),)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+endif
+
+ifndef PACKAGESDIR
+PACKAGESDIR=$(FPCDIR)/packages
+endif
+ifndef TOOLKITSDIR
+TOOLKITSDIR=
+endif
+ifndef COMPONENTSDIR
+COMPONENTSDIR=
+endif
+
+# Create units dir
+ifneq ($(FPCDIR),.)
+UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
+endif
+
+#####################################################################
+# User Settings
+#####################################################################
+
+
+# Targets
+
+override UNITOBJECTS+=interbase
+override EXEOBJECTS+=testib
+
+# Clean
+
+
+# Install
+
+ZIPTARGET=install
+
+# Defaults
+
+override NEEDOPT=-S2
+
+# Directories
+
+override NEEDUNITDIR=..
+ifndef TARGETDIR
+TARGETDIR=.
+endif
+
+# Packages
+
+override PACKAGES+=rtl fcl ibase
+
+# Libraries
+
+override NEEDGCCLIB=1
+
+# Info
+
+INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
+
+#####################################################################
+# Shell tools
+#####################################################################
+
+# echo
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=echo
+ECHOE:=echo
+else
+ECHO:=$(firstword $(ECHO))
+ECHOE=$(ECHO) -E
+endif
+else
+ECHO:=$(firstword $(ECHO))
+ECHOE=$(ECHO) -E
+endif
+endif
+
+# To copy pograms
+ifndef COPY
+COPY:=cp -fp
+endif
+
+# Copy a whole tree
+ifndef COPYTREE
+COPYTREE:=cp -rfp
+endif
+
+# To move pograms
+ifndef MOVE
+MOVE:=mv -f
+endif
+
+# Check delete program
+ifndef DEL
+DEL:=rm -f
+endif
+
+# Check deltree program
+ifndef DELTREE
+DELTREE:=rm -rf
+endif
+
+# To install files
+ifndef INSTALL
+ifdef inlinux
+INSTALL:=install -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+
+# To install programs
+ifndef INSTALLEXE
+ifdef inlinux
+INSTALLEXE:=install -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+
+# To make a directory.
+ifndef MKDIR
+ifdef inlinux
+MKDIR:=install -m 755 -d
+else
+MKDIR:=ginstall -m 755 -d
+endif
+endif
+
+export ECHO ECHOE COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+
+#####################################################################
+# Default Tools
+#####################################################################
+
+# assembler, redefine it if cross compiling
+ifndef AS
+AS=as
+endif
+
+# linker, but probably not used
+ifndef LD
+LD=ld
+endif
+
+# ppas.bat / ppas.sh
+ifdef inlinux
+PPAS=ppas.sh
+else
+ifdef inOS2
+PPAS=ppas.cmd
+else
+PPAS=ppas.bat
+endif
+endif
+
+# ldconfig to rebuild .so cache
+ifdef inlinux
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+
+# ppumove
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE=
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+
+# ppufiles
+ifndef PPUFILES
+PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUFILES),)
+PPUFILES=
+else
+PPUFILES:=$(firstword $(PPUFILES))
+endif
+endif
+export PPUFILES
+
+# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
+# upx uses that one itself (PFV)
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+
+# ZipProg, you can't use Zip as the var name (PFV)
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG=
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+
+ZIPOPT=-9
+ZIPEXT=.zip
+
+# Tar
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(EXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG=
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+
+ifeq ($(USETAR),bz2)
+TAROPT=vI
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+
+#####################################################################
+# Default extensions
+#####################################################################
+
+# Default needed extensions (Go32v2,Linux)
+LOADEREXT=.as
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+RSTEXT=.rst
+FPCMADE=fpcmade
+
+# Go32v1
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+FPCMADE=fpcmade.v1
+endif
+
+# Go32v2
+ifeq ($(OS_TARGET),go32v2)
+FPCMADE=fpcmade.dos
+endif
+
+# Linux
+ifeq ($(OS_TARGET),linux)
+FPCMADE=fpcmade.lnx
+endif
+
+# Win32
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.w32
+endif
+
+# OS/2
+ifeq ($(OS_TARGET),os2)
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+SMARTEXT=.so
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+FPCMADE=fpcmade.os2
+endif
+
+# library prefix
+LIBPREFIX=lib
+ifeq ($(OS_TARGET),go32v2)
+LIBPREFIX=
+endif
+ifeq ($(OS_TARGET),go32v1)
+LIBPREFIX=
+endif
+
+# determine which .pas extension is used
+ifndef PASEXT
+ifdef EXEOBJECTS
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
+else
+override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
+endif
+ifeq ($(TESTPAS),)
+PASEXT=.pp
+else
+PASEXT=.pas
+endif
+endif
+
+
+# Check if the dirs really exists, else turn it off
+ifeq ($(wildcard $(UNITSDIR)),)
+UNITSDIR=
+endif
+ifeq ($(wildcard $(TOOLKITSDIR)),)
+TOOLKITSDIR=
+endif
+ifeq ($(wildcard $(PACKAGESDIR)),)
+PACKAGESDIR=
+endif
+ifeq ($(wildcard $(COMPONENTSDIR)),)
+COMPONENTSDIR=
+endif
+
+
+# PACKAGESDIR packages
+
+PACKAGERTL=1
+PACKAGEFCL=1
+PACKAGEIBASE=1
+
+ifdef PACKAGERTL
+ifneq ($(wildcard $(FPCDIR)/rtl),)
+ifneq ($(wildcard $(FPCDIR)/rtl/$(OS_TARGET)),)
+PACKAGEDIR_RTL=$(FPCDIR)/rtl/$(OS_TARGET)
+else
+PACKAGEDIR_RTL=$(FPCDIR)/rtl
+endif
+ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_rtl
+package_rtl:
+	$(MAKE) -C $(PACKAGEDIR_RTL) all
+endif
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+else
+PACKAGEDIR_RTL=
+ifneq ($(wildcard $(UNITSDIR)/rtl),)
+ifneq ($(wildcard $(UNITSDIR)/rtl/$(OS_TARGET)),)
+UNITDIR_RTL=$(UNITSDIR)/rtl/$(OS_TARGET)
+else
+UNITDIR_RTL=$(UNITSDIR)/rtl
+endif
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override NEEDUNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifdef PACKAGEFCL
+ifneq ($(wildcard $(FPCDIR)/fcl),)
+ifneq ($(wildcard $(FPCDIR)/fcl/$(OS_TARGET)),)
+PACKAGEDIR_FCL=$(FPCDIR)/fcl/$(OS_TARGET)
+else
+PACKAGEDIR_FCL=$(FPCDIR)/fcl
+endif
+ifeq ($(wildcard $(PACKAGEDIR_FCL)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_fcl
+package_fcl:
+	$(MAKE) -C $(PACKAGEDIR_FCL) all
+endif
+UNITDIR_FCL=$(PACKAGEDIR_FCL)
+else
+PACKAGEDIR_FCL=
+ifneq ($(wildcard $(UNITSDIR)/fcl),)
+ifneq ($(wildcard $(UNITSDIR)/fcl/$(OS_TARGET)),)
+UNITDIR_FCL=$(UNITSDIR)/fcl/$(OS_TARGET)
+else
+UNITDIR_FCL=$(UNITSDIR)/fcl
+endif
+else
+UNITDIR_FCL=
+endif
+endif
+ifdef UNITDIR_FCL
+override NEEDUNITDIR+=$(UNITDIR_FCL)
+endif
+endif
+ifdef PACKAGEIBASE
+ifneq ($(wildcard $(PACKAGESDIR)/ibase),)
+ifneq ($(wildcard $(PACKAGESDIR)/ibase/$(OS_TARGET)),)
+PACKAGEDIR_IBASE=$(PACKAGESDIR)/ibase/$(OS_TARGET)
+else
+PACKAGEDIR_IBASE=$(PACKAGESDIR)/ibase
+endif
+ifeq ($(wildcard $(PACKAGEDIR_IBASE)/$(FPCMADE)),)
+override COMPILEPACKAGES+=package_ibase
+package_ibase:
+	$(MAKE) -C $(PACKAGEDIR_IBASE) all
+endif
+UNITDIR_IBASE=$(PACKAGEDIR_IBASE)
+else
+PACKAGEDIR_IBASE=
+ifneq ($(wildcard $(UNITSDIR)/ibase),)
+ifneq ($(wildcard $(UNITSDIR)/ibase/$(OS_TARGET)),)
+UNITDIR_IBASE=$(UNITSDIR)/ibase/$(OS_TARGET)
+else
+UNITDIR_IBASE=$(UNITSDIR)/ibase
+endif
+else
+UNITDIR_IBASE=
+endif
+endif
+ifdef UNITDIR_IBASE
+override NEEDUNITDIR+=$(UNITDIR_IBASE)
+endif
+endif
+
+
+#####################################################################
+# Default Directories
+#####################################################################
+
+# set the prefix directory where to install everything
+ifndef PREFIXINSTALLDIR
+ifdef inlinux
+PREFIXINSTALLDIR=/usr
+else
+PREFIXINSTALLDIR=/pp
+endif
+endif
+export PREFIXINSTALLDIR
+
+# Where to place the resulting zip files
+ifndef DESTZIPDIR
+DESTZIPDIR:=$(BASEDIR)
+endif
+export DESTZIPDIR
+
+# On linux, try to find where libgcc.a is.
+ifdef inlinux
+ifndef GCCLIBDIR
+GCCLIBDIR:=$(shell dirname `(gcc -v 2>&1)| head -n 1| awk '{ print $$4 } '`)
+endif
+endif
+export GCCLIBDIR
+
+#####################################################################
+# Install Directories
+#####################################################################
+
+# set the base directory where to install everything
+ifndef BASEINSTALLDIR
+ifdef inlinux
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
+else
+BASEINSTALLDIR=$(PREFIXINSTALLDIR)
+endif
+endif
+
+# set the directory where to install the binaries
+ifndef BININSTALLDIR
+ifdef inlinux
+BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
+else
+BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
+endif
+endif
+
+# set the directory where to install the units.
+ifndef UNITINSTALLDIR
+UNITINSTALLDIR=$(BASEINSTALLDIR)/units/$(OS_TARGET)
+ifdef UNITSUBDIR
+UNITINSTALLDIR:=$(UNITINSTALLDIR)/$(UNITSUBDIR)
+endif
+endif
+
+# Where to install shared libraries
+ifndef LIBINSTALLDIR
+ifdef inlinux
+LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
+else
+LIBINSTALLDIR=$(UNITINSTALLDIR)
+endif
+endif
+
+# Where the source files will be stored
+ifndef SOURCEINSTALLDIR
+ifdef inlinux
+SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
+else
+SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
+endif
+ifdef SOURCESUBDIR
+SOURCEINSTALLDIR:=$(SOURCEINSTALLDIR)/$(SOURCESUBDIR)
+endif
+endif
+
+# Where the doc files will be stored
+ifndef DOCINSTALLDIR
+ifdef inlinux
+DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc-$(FPC_VERSION)
+else
+DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
+endif
+endif
+
+# Where the some extra (data)files will be stored
+ifndef DATAINSTALLDIR
+DATAINSTALLDIR=$(BASEINSTALLDIR)
+endif
+
+#####################################################################
+# Redirection
+#####################################################################
+
+ifndef REDIRFILE
+REDIRFILE=log
+endif
+
+ifdef REDIR
+ifndef inlinux
+override FPC=redir -eo $(FPC)
+endif
+# set the verbosity to max
+override FPCOPT+=-va
+override REDIR:= >> $(REDIRFILE)
+endif
+
+
+#####################################################################
+# Compiler Command Line
+#####################################################################
+
+# Load commandline OPTDEF and add FPC_CPU define
+override FPCOPTDEF:=-d$(CPU_TARGET)
+
+# Load commandline OPT and add target and unit dir to be sure
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+
+ifdef NEEDOPT
+override FPCOPT+=$(NEEDOPT)
+endif
+
+ifdef NEEDUNITDIR
+override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR))
+endif
+
+ifdef UNITSDIR
+override FPCOPT+=-Fu$(UNITSDIR)
+endif
+
+# Add GCC lib path if asked
+ifdef GCCLIBDIR
+override FPCOPT+=-Fl$(GCCLIBDIR)
+endif
+
+# Target dirs
+ifdef TARGETDIR
+override FPCOPT+=-FE$(TARGETDIR)
+endif
+
+# Smartlinking
+ifdef LINKSMART
+override FPCOPT+=-CX
+endif
+
+# Smartlinking
+ifdef CREATESMART
+override FPCOPT+=-XX
+endif
+
+# Debug
+ifdef DEBUG
+override FPCOPT+=-g -dDEBUG
+endif
+
+# Release mode (strip, optimize and don't load ppc386.cfg)
+# 0.99.12b has a bug in the optimizer so don't use it by default
+ifdef RELEASE
+ifeq ($(FPC_VERSION),0.99.12)
+override FPCOPT+=-Xs -OGp3 -n
+else
+override FPCOPT+=-Xs -OG2p3 -n
+endif
+endif
+
+# Strip
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+
+# Optimizer
+ifdef OPTIMIZE
+override FPCOPT+=-OG2p3
+endif
+
+# Verbose settings (warning,note,info)
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+
+# Add commandline options
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+
+# Add defines from FPCOPTDEF to FPCOPT
+ifdef FPCOPTDEF
+override FPCOPT+=$(FPCOPTDEF)
+endif
+
+# Error file ?
+ifdef ERRORFILE
+override FPCOPT+=-Fr$(ERRORFILE)
+endif
+
+# Was a config file specified ?
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+
+# For win32 the options are passed using the environment FPCEXTCMD
+ifeq ($(OS_SOURCE),win32)
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+
+# Compiler commandline
+override COMPILER:=$(FPC) $(FPCOPT)
+
+# also call ppas if with command option -s
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+EXECPPAS:=@$(PPAS)
+endif
+
+#####################################################################
+# Standard rules
+#####################################################################
+
+all: fpc_all
+
+debug: fpc_debug
+
+smart: fpc_smart
+
+shared: fpc_shared
+
+showinstall: fpc_showinstall
+
+install: fpc_install
+
+sourceinstall: fpc_sourceinstall
+
+zipinstall: fpc_zipinstall
+
+zipsourceinstall: fpc_zipsourceinstall
+
+clean: fpc_clean
+
+distclean: fpc_distclean
+
+cleanall: fpc_cleanall
+
+info: fpc_info
+
+.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipsourceinstall clean distclean cleanall info
+
+#####################################################################
+# Units
+#####################################################################
+
+.PHONY: fpc_units
+
+override ALLTARGET+=fpc_units
+
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
+override INSTALLPPUFILES+=$(UNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES)
+
+fpc_units: $(UNITPPUFILES)
+
+#####################################################################
+# Exes
+#####################################################################
+
+.PHONY: fpc_exes
+
+ifdef EXEOBJECTS
+override EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
+override EXEOFILES=$(addsuffix $(OEXT),$(EXEOBJECTS))
+
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+endif
+
+fpc_exes: $(EXEFILES)
+
+#####################################################################
+# General compile rules
+#####################################################################
+
+.PHONY: fpc_packages fpc_all fpc_debug
+
+$(FPCMADE): $(ALLTARGET)
+	@$(ECHO) Compiled > $(FPCMADE)
+
+fpc_packages: $(COMPILEPACKAGES)
+
+fpc_all: fpc_packages $(FPCMADE)
+
+fpc_debug:
+	$(MAKE) all DEBUG=1
+
+# General compile rules, available for both possible PASEXT
+
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
+
+%$(PPUEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+%$(PPUEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+%$(EXEEXT): %.pp
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+%$(EXEEXT): %.pas
+	$(COMPILER) $< $(REDIR)
+	$(EXECPPAS)
+
+#####################################################################
+# Library
+#####################################################################
+
+.PHONY: fpc_smart fpc_shared
+
+# Default sharedlib units are all unit objects
+ifndef SHAREDLIBUNITOBJECTS
+SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
+endif
+
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+
+fpc_shared: all
+ifdef inlinux
+ifndef LIBNAME
+	@$(ECHO) "LIBNAME not set"
+else
+	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
+endif
+else
+	@$(ECHO) "Shared Libraries not supported"
+endif
+
+#####################################################################
+# Install rules
+#####################################################################
+
+.PHONY: fpc_showinstall fpc_install
+
+ifdef EXTRAINSTALLUNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
+endif
+
+ifdef INSTALLPPUFILES
+ifdef PPUFILES
+ifdef inlinux
+INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
+INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
+else
+INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
+endif
+else
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
+endif
+endif
+
+fpc_showinstall: $(SHOWINSTALLTARGET)
+ifdef INSTALLEXEFILES
+	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
+endif
+ifdef INSTALLPPUFILES
+	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
+ifneq ($(INSTALLPPULINKFILES),)
+	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	@$(ECHO) -e $(addprefix "\n"$(DATAINSTALLDIR)/,$(EXTRAINSTALLFILES))
+endif
+
+fpc_install: $(INSTALLTARGET)
+# Create UnitInstallFiles
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(BININSTALLDIR)
+# Compress the exes if upx is defined
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(UNITINSTALLDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
+endif
+ifneq ($(INSTALLPPULIBFILES),)
+	$(MKDIR) $(LIBINSTALLDIR)
+	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
+endif
+endif
+ifdef EXTRAINSTALLFILES
+	$(MKDIR) $(DATAINSTALLDIR)
+	$(INSTALL) $(EXTRAINSTALLFILES) $(DATAINSTALLDIR)
+endif
+
+#####################################################################
+# SourceInstall rules
+#####################################################################
+
+.PHONY: fpc_sourceinstall
+
+ifndef SOURCETOPDIR
+SOURCETOPDIR=$(BASEDIR)
+endif
+
+fpc_sourceinstall: clean
+	$(MKDIR) $(SOURCEINSTALLDIR)
+	$(COPYTREE) $(SOURCETOPDIR) $(SOURCEINSTALLDIR)
+
+#####################################################################
+# Zip
+#####################################################################
+
+.PHONY: fpc_zipinstall
+
+# Create suffix to add
+ifndef PACKAGESUFFIX
+PACKAGESUFFIX=$(OS_TARGET)
+ifeq ($(OS_TARGET),go32v2)
+PACKAGESUFFIX=go32
+endif
+ifeq ($(OS_TARGET),win32)
+PACKAGESUFFIX=w32
+endif
+endif
+
+# Temporary path to pack a file
+ifndef PACKDIR
+ifndef inlinux
+PACKDIR=$(BASEDIR)/pack_tmp
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+
+# Maybe create default zipname from packagename
+ifndef ZIPNAME
+ifdef PACKAGENAME
+ZIPNAME=$(PACKAGEPREFIX)$(PACKAGENAME)$(PACKAGESUFFIX)
+endif
+endif
+
+# Use tar by default under linux
+ifndef USEZIP
+ifdef inlinux
+USETAR=1
+endif
+endif
+
+fpc_zipinstall:
+ifndef ZIPNAME
+	@$(ECHO) "Please specify ZIPNAME!"
+	@exit 1
+else
+	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
+ifdef USETAR
+	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT)
+	cd $(PACKDIR) ; $(TARPROG) c$(TAROPT) --file $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT) * ; cd $(BASEDIR)
+else
+	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT)
+	cd $(PACKDIR) ; $(ZIPPROG) -Dr $(ZIPOPT) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT) * ; cd $(BASEDIR)
+endif
+	$(DELTREE) $(PACKDIR)
+endif
+
+.PHONY:  fpc_zipsourceinstall
+
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall PACKAGESUFFIX=src
+
+#####################################################################
+# Clean rules
+#####################################################################
+
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+
+ifdef EXTRACLEANUNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
+endif
+
+ifdef CLEANPPUFILES
+ifdef PPUFILES
+CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
+else
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
+endif
+endif
+
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(CLEANRSTFILES)
+endif
+ifdef EXTRACLEANFILES
+	-$(DEL) $(EXTRACLEANFILES)
+endif
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+
+fpc_distclean: fpc_clean
+
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+
+#####################################################################
+# Info rules
+#####################################################################
+
+.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
+	fpc_dirinfo
+
+fpc_info: $(INFOTARGET)
+
+fpc_infocfg:
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC....... $(FPC)
+	@$(ECHO)  Version... $(FPC_VERSION)
+	@$(ECHO)  CPU....... $(CPU_TARGET)
+	@$(ECHO)  Source.... $(OS_SOURCE)
+	@$(ECHO)  Target.... $(OS_TARGET)
+	@$(ECHO)
+
+fpc_infoobjects:
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
+	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
+	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
+	@$(ECHO)
+	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
+	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
+	@$(ECHO)
+	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
+	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
+	@$(ECHO)
+
+fpc_infoinstall:
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+ifdef DATE
+	@$(ECHO)  DateStr.............. $(DATESTR)
+endif
+ifdef PACKAGEPREFIX
+	@$(ECHO)  PackagePrefix........ $(PACKAGEPREFIX)
+endif
+ifdef PACKAGENAME
+	@$(ECHO)  PackageName.......... $(PACKAGENAME)
+endif
+	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
+	@$(ECHO)
+	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
+	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
+	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
+	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
+	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
+	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
+	@$(ECHO)  DataInstallDir....... $(DATAINSTALLDIR)
+	@$(ECHO)
+	@$(ECHO)  DestZipDir........... $(DESTZIPDIR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)
+
+#####################################################################
+# Local Makefile
+#####################################################################
+
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+

+ 22 - 0
fcl/db/interbase/Makefile.fpc

@@ -0,0 +1,22 @@
+#
+#   Makefile.fpc for interbase dataset
+#
+
+[targets]
+units=interbase
+programs=testib
+
+[defaults]
+defaultcpu=i386
+
+[require]
+options=-S2
+packages=fcl ibase
+
+[dirs]
+fpcdir=../..
+targetdir=.
+unitdir=..
+
+[libs]
+libgcc=1

+ 23 - 0
fcl/db/interbase/README

@@ -0,0 +1,23 @@
+This is first working release of TDatabase and TDataset 
+implementation for Interbase SQL server.
+
+Compiling the units:
+
+Run 'make; make examples' command, if something goes wrong, look if you have
+
+  1) unit ibase60 in compiler path
+  2) gds.so.0 library in /usr/lib
+  
+Command 'sh mkdb' creates testing database in current directory.
+  
+Unit interbase.pp was made and tested on Linux, on ib60 server,
+I don't know if it's working on other OS platforms or other
+versions of IB server.
+
+Unit in these days provides objective connectivity to IB server, 
+basic SQL statement support. It's still buggy, so volunteers
+and contributors are welcome. It supports SQL dialect 1 only 
+(You cannot use date & time datatypes in tables).
+
+Pavel Stingl
[email protected]

+ 848 - 0
fcl/db/interbase/interbase.pp

@@ -0,0 +1,848 @@
+{
+    $Id$
+    Copyright (c) 2000 by Pavel Stingl
+
+
+    Interbase database & dataset
+    
+    Roughly based on work of FPC development team,
+    especially Michael Van Canneyt 
+
+    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.
+
+ **********************************************************************}
+
+unit interbase;
+
+{$H+}
+
+interface 
+
+uses SysUtils, Classes, ibase60, Db;
+
+type
+
+  PInteger = ^integer;
+
+  TIBDatabase = class (TDatabase)
+  private
+    FIBDatabaseHandle    : pointer;
+    FIBTransactionHandle : pointer;
+    FPassword            : string;
+    FStatus              : array [0..19] of ISC_STATUS;
+    FUserName            : string;
+    
+    procedure CheckError(ProcName : string);
+  protected
+    procedure DoInternalConnect; override;
+    procedure DoInternalDisconnect; override;
+  public
+    constructor Create(AOwner : TComponent); override;
+
+    procedure CommitTransaction; virtual;
+    procedure RollbackTransaction; virtual;
+    procedure StartTransaction; override;
+    procedure EndTransaction; override;
+
+    property DatabaseHandle: pointer read FIBDatabaseHandle; 
+    property TransactionHandle: pointer read FIBTransactionHandle;
+  published
+    property Password: string read FPassword write FPassword;
+    property UserName: string read FUserName write FUserName;
+    
+    property Connected;
+    property DatabaseName;
+    property KeepConnection;
+    property LoginPrompt;
+    property Params;
+    property OnLogin;
+  end;
+
+  PIBBookmark = ^TIBBookmark;
+  TIBBookmark = record
+    BookmarkData: Integer;
+    BookmarkFlag: TBookmarkFlag;
+  end;
+  
+  // TStatementType indicates if SQL statement returns
+  // result set.
+  TStatementType = (stResult, stNoResult, stDDL);
+  
+  TIBDataset = class (TDataset)
+  private
+    FBufferSize          : longint;
+    FCurrentRecord       : longint;
+    FCurrStmtType        : TStatementType;
+    FDatabase            : TIBDatabase;
+    FFlag                : array [0..1024] of shortint;
+    FIsEOF               : boolean;
+    FLoadingFieldDefs    : boolean;
+	FSQLPrepared		 : boolean;
+    FRecordSize          : word;
+    FRecordCount         : integer;
+    FSQL                 : TStrings;
+    FSQLDA               : PXSQLDA;
+    FSQLDAAllocated      : longint;
+    FStatementHandle     : pointer;
+    FStatus              : array [0..19] of ISC_STATUS;
+    
+    FDBHandle            : pointer;
+    FTRHandle            : pointer;
+    
+    procedure CheckError(ProcName : string);
+    procedure DoAssignBuffers;
+    procedure DoExecSQL;
+    procedure DoFetch;
+    procedure DoFreeBuffers;
+    procedure DoParseSQL;
+    procedure DoSQLDAAlloc(Count : longint);
+    procedure DoStmtAlloc;
+    procedure DoStmtDealloc;
+    
+    procedure SetBufExtended(Field : TField; CurrBuff,Buffer : pointer);
+    procedure SetBufInteger(Field : TField; CurrBuff,Buffer : pointer);
+    procedure SetBufDateTime(Field : TField; CurrBuff,Buffer : pointer; AType : integer);
+    procedure SetBufString(Field : TField; CurrBuff,Buffer : pointer);
+    
+    function GetStmtType: TStatementType;
+    
+    function LoadBufferFromData(Buffer : PChar): TGetResult;
+    procedure SetDatabase(Value : TIBDatabase);
+    procedure SetSizes;
+    procedure TranslateFieldType(AType, AScale: longint; 
+      var XType: TFieldType; var XScale: word);
+  protected
+    function AllocRecordBuffer: PChar; override;
+    procedure FreeRecordBuffer(var Buffer: PChar); override;
+    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
+    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
+    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
+    function GetRecordSize: Word; override;
+	function GetRecordCount: integer; override;
+    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
+    procedure InternalClose; override;
+    procedure InternalDelete; override;
+    procedure InternalFirst; override;
+    procedure InternalGotoBookmark(ABookmark: Pointer); override;
+    procedure InternalHandleException; override;
+    procedure InternalInitFieldDefs; override;
+    procedure InternalInitRecord(Buffer: PChar); override;
+    procedure InternalLast; override;
+    procedure InternalOpen; override;
+    procedure InternalPost; override;
+    procedure InternalSetToRecord(Buffer: PChar); override;
+    function IsCursorOpen: Boolean; override;
+    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
+    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
+    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
+  public
+    constructor Create(AOwner : TComponent); override;
+    destructor Destroy; override;
+  published
+    property SQL : TStrings read FSQL write FSQL;
+    property Database : TIBDatabase read FDatabase write SetDatabase;
+  end;
+
+implementation
+
+type
+
+  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;
+  end;
+
+
+///////////////////////////////////////////////////////////////////////
+// TIBDatabase implementation
+//
+
+// PRIVATE PART of TIBDatabase
+
+{---------------------------------------------------------------------}
+{ CheckError                                                          }
+{ This procedure checks IB status vector and, if found some error     }
+{ condition, raises exception with IB error text                      }
+{---------------------------------------------------------------------}
+
+procedure TIBDatabase.CheckError(ProcName:string);
+var
+  buf : array [0..1024] of char;
+  P : pointer;
+  x : integer;
+begin
+  if ((FStatus[0] = 1) and (FStatus[1] <> 0)) then
+  begin
+    p := @FStatus;
+    isc_interprete(Buf, @p);
+    raise Exception.Create(ProcName + ': ' + StrPas(buf));
+  end;
+end;
+
+
+// PROTECTED PART of TIBDatabase
+
+procedure TIBDatabase.DoInternalConnect;
+var
+  DPB : string;
+begin
+  if Connected then
+    Close;    
+  DPB := chr(isc_dpb_version1);
+  if (FUserName <> '') then
+  begin
+    DPB := DPB + chr(isc_dpb_user_name) + chr(Length(FUserName)) + FUserName;
+    if (FPassword <> '') then
+      DPB := DPB + chr(isc_dpb_password) + chr(Length(FPassword)) + FPassword;
+  end;
+  if (DatabaseName = '') then
+    raise Exception.Create('TIBDatabase.Open: Database connect string not filled in!');
+  FIBDatabaseHandle := nil;
+  if isc_attach_database(@FStatus, Length(DatabaseName), @DatabaseName[1], @FIBDatabaseHandle, 
+         Length(DPB), @DPB[1]) <> 0 then
+    CheckError('TIBDatabase.Open');
+end;
+
+procedure TIBDatabase.DoInternalDisconnect;
+begin
+  if not Connected then
+  begin
+    FIBDatabaseHandle := nil;
+    Exit;
+  end;
+  isc_detach_database(@FStatus[0], @FIBDatabaseHandle);
+  CheckError('TIBDatabase.Close');
+end;
+
+
+// PUBLIC PART of TIBDatabase
+
+constructor TIBDatabase.Create(AOwner : TComponent);
+begin
+  inherited Create(AOwner);
+  FIBDatabaseHandle := nil;
+  FIBTransactionHandle := nil;
+  FUserName := '';
+  FPassword := '';
+end;
+
+procedure TIBDatabase.CommitTransaction;
+begin
+  if FIBTransactionHandle <> nil then
+    if isc_commit_retaining(@FStatus, @FIBTransactionHandle) <> 0 then
+      CheckError('TIBDatabase.CommitTransaction');
+end;
+
+procedure TIBDatabase.RollbackTransaction;
+begin
+  if FIBTransactionHandle <> nil then
+    if isc_rollback_retaining(@FStatus, FIBTransactionHandle) <> 0 then
+      CheckError('TIBDatabase.RollbackTransaction');
+end;
+
+procedure TIBDatabase.StartTransaction;
+begin
+  if FIBTransactionHandle = nil then
+  begin
+    if isc_start_transaction(@FStatus, @FIBTransactionHandle, 1, [@FIBDatabaseHandle, 0, nil]) <> 0 then
+      CheckError('TIBDatabase.StartTransaction');
+  end;
+end;
+
+procedure TIBDatabase.EndTransaction;
+begin
+  if FIBTransactionHandle <> nil then
+  begin
+    if isc_commit_transaction(@FStatus, @FIBTransactionHandle) <> 0 then
+      CheckError('TIBDatabase.EndTransaction');
+    FIBTransactionHandle := nil;
+  end;
+end;
+
+
+///////////////////////////////////////////////////////////////////////
+// TIBDataset implementation
+//
+
+// PRIVATE PART
+
+procedure TIBDataset.CheckError(ProcName : string);
+var
+  buf : array [0..1024] of char;
+  P : pointer;
+  Msg : string;
+  x : integer;
+begin
+  if ((FStatus[0] = 1) and (FStatus[1] <> 0)) then
+  begin
+    p := @FStatus;
+    while isc_interprete(Buf, @p) > 0 do
+      Msg := Msg + #10' -' + StrPas(Buf);
+    raise Exception.Create(ProcName + ': ' + Msg);
+  end;
+end;
+
+procedure TIBDataset.DoAssignBuffers;
+var
+  Buf : PChar;
+  x   : longint;
+begin
+  for x := 0 to FSQLDA^.SQLD - 1 do
+  begin
+    Buf := AllocMem(FSQLDA^.SQLVar[x].SQLLen);
+    FSQLDA^.SQLVar[x].SQLData := Buf;
+    FSQLDA^.SQLVar[x].SQLInd  := @FFlag[x];
+  end;
+end;
+
+procedure TIBDataset.DoExecSQL;
+begin
+  if isc_dsql_execute(@FStatus, @FTrHandle, @FStatementHandle, 1, nil) <> 0 then
+    CheckError('TIBDataset.DoExecSQL');
+end;
+
+procedure TIBDataset.DoFetch;
+var
+  Res : longint;
+begin
+  if FCurrStmtType <> stResult then Exit;
+  Res := isc_dsql_fetch(@FStatus, @FStatementHandle, 1, FSQLDA);
+  if (Res <> 100) then
+    CheckError('TIBDataset.DoFetch');
+  FIsEOF := (Res = 100);
+end;
+
+procedure TIBDataset.DoFreeBuffers;
+var
+  x   : longint;
+begin
+  for x := 0 to FSQLDA^.SQLD - 1 do
+    if (FSQLDA^.SQLVar[x].SQLData <> nil) then
+      FreeMem(FSQLDA^.SQLVar[x].SQLData);
+end;
+
+procedure TIBDataset.DoParseSQL;
+var
+  Buf      : string;
+  x        : longint;
+begin
+  if FSQL.Count < 1 then
+    raise Exception.Create('TIBDataset.DoParseSQL: Empty SQL statement');
+
+  Buf := '';
+  for x := 0 to FSQL.Count - 1 do
+    Buf := Buf + FSQL[x] + ' ';
+
+  if isc_dsql_prepare(@FStatus, @FTrHandle, @FStatementHandle, 0, @Buf[1], 1, nil) <> 0 then    CheckError('TIBDataset.DoParseSQL - Prepare');
+    
+  if isc_dsql_describe(@FStatus, @FStatementHandle, 1, FSQLDA) <> 0 then
+    CheckError('TIBDataset.DoParseSQL - Describe');
+
+  if FSQLDA^.SQLN < FSQLDA^.SQLD then
+  begin
+    x := FSQLDA^.SQLD;
+    DoSQLDAAlloc(x);
+    if isc_dsql_describe(@FStatus, @FStatementHandle, 1, FSQLDA) <> 0 then
+      CheckError('TIBDataset.DoParseSQL - Describe');
+  end;
+  
+  FCurrStmtType := GetStmtType;
+  FSQLPrepared := True;  
+end;
+
+procedure TIBDataset.DoSQLDAAlloc(Count : longint);
+begin
+  if FSQLDAAllocated > 0 then
+    FreeMem(FSQLDA, XSQLDA_Length * FSQLDAAllocated);
+  GetMem(FSQLDA, XSQLDA_Length * Count);
+  FSQLDAAllocated := Count;
+  FSQLDA^.Version := SQLDA_VERSION1;
+  FSQLDA^.SQLN := Count;
+end;
+
+procedure TIBDataset.DoStmtAlloc;
+begin
+  if not FDatabase.Connected then
+    FDatabase.Open;
+  if FDatabase.TransactionHandle = nil then
+    FDatabase.StartTransaction;
+  FDBHandle := FDatabase.DatabaseHandle;
+  FTRHandle := FDatabase.TransactionHandle;
+
+  if isc_dsql_allocate_statement(@FStatus, @FDBHandle, @FStatementHandle) <> 0 then
+    CheckError('TIBDataset.DoStmtAlloc');
+end;
+
+procedure TIBDataset.DoStmtDealloc;
+begin
+  if isc_dsql_free_statement(@FStatus, @FStatementHandle, DSQL_Drop) <> 0 then
+    CheckError('TIBDataset.DoStmtDealloc');
+  FStatementHandle := nil;
+end;
+
+function TIBDataset.GetStmtType: TStatementType;
+var
+  ResBuf : array [0..7] of char;
+  x : integer;
+  SType : integer;
+begin
+  x := isc_info_sql_stmt_type;
+  isc_dsql_sql_info(@FStatus, @FStatementHandle, SizeOf(x),
+    @x, SizeOf(ResBuf), @ResBuf);
+  if Ord(ResBuf[0]) = isc_info_sql_stmt_type then
+  begin
+    x := isc_vax_integer(@ResBuf[1], 2);
+    SType := isc_vax_integer(@ResBuf[3], x);
+  end;
+  case SType of
+    isc_info_sql_stmt_select:
+      Result := stResult;
+    isc_info_sql_stmt_insert, isc_info_sql_stmt_update,
+    isc_info_sql_stmt_delete:
+      Result := stNoResult;
+    else Result := stDDL;
+  end;
+end;
+
+function TIBDataset.LoadBufferFromData(Buffer : PChar): TGetResult;
+var
+  x : integer;
+  p : word;
+  T : TISC_TIMESTAMP;
+begin
+  DoFetch;
+  if FIsEOF then
+    Result := grEOF
+  else begin
+    for x := 0 to FSQLDA^.SQLD - 1 do
+    begin
+      if (FSQLDA^.SQLVar[x].SQLType = SQL_VARYING) or
+         (FSQLDA^.SQLVar[x].SQLType = SQL_VARYING + 1) then
+      begin
+        Move(FSQLDA^.SQLVar[x].SQLData^, P, 2);
+    	Move((FSQLDA^.SQLVar[x].SQLData + 2)^, Buffer^, P);
+        PChar(Buffer+P)^ := #0;
+      end
+	  else
+    	Move(FSQLDA^.SQLVar[x].SQLData^, Buffer^, FSQLDA^.SQLVar[x].SQLLen);
+      Inc(Buffer,FSQLDA^.SQLVar[x].SQLLen);
+    end;
+    Result := grOK;
+  end;
+end;
+
+procedure TIBDataset.SetDatabase(Value : TIBDatabase);
+begin
+  CheckInactive;
+  If Value<>FDatabase then
+  begin
+    if Value<>Nil Then
+      FDatabase:=Value; 
+  end;
+end;
+
+procedure TIBDataset.SetSizes;
+var
+  x : integer;
+begin
+  FRecordSize := 0;
+  FBufferSize := 0;
+  for x := 0 to FSQLDA^.SQLD - 1 do
+  begin
+    Inc(FRecordSize, FSQLDA^.SQLVar[x].SQLLen);
+  end;
+  FBufferSize := FRecordSize + SizeOf(TIBBookmark);
+end;
+
+procedure TIBDataset.TranslateFieldType(AType, AScale: longint; 
+  var XType: TFieldType; var XScale: word);
+begin
+  case AType of
+    SQL_TEXT, SQL_VARYING, SQL_TEXT+1, SQL_VARYING+1:
+      begin
+        XType := ftString;
+        XScale := AScale;
+      end;
+    SQL_DOUBLE, SQL_DOUBLE+1: 
+      begin
+        XType := ftFloat;
+        XScale := AScale;
+      end;
+    SQL_LONG, SQL_LONG+1, SQL_SHORT, SQL_SHORT+1: 
+      begin
+        XType := ftInteger;
+        XScale := AScale;
+      end;
+{    SQL_DATE, SQL_DATE+1, SQL_TIME, SQL_TIME+1,}
+    SQL_TYPE_TIME:
+      begin
+        XType := ftTime;
+        XScale := AScale;
+      end;
+    SQL_TYPE_DATE:
+      begin
+        XType := ftDate;
+        XScale := AScale;
+      end;
+    SQL_FLOAT,SQL_FLOAT+1:
+      begin
+        XType := ftFloat;
+        XScale := AScale;
+      end;
+    SQL_TIMESTAMP, SQL_TIMESTAMP+1: 
+      begin
+        XType := ftDateTime;
+        XScale := AScale;
+      end;
+  end;
+end;
+
+
+// PROTECTED PART
+
+function TIBDataset.AllocRecordBuffer: PChar;
+begin
+  Result := AllocMem(FBufferSize);
+end;
+
+procedure TIBDataset.FreeRecordBuffer(var Buffer: PChar);
+begin
+  FreeMem(Buffer);
+end;
+
+procedure TIBDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  PInteger(Data)^ := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
+end;
+
+function TIBDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
+begin
+  Result := PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag;
+end;
+
+procedure TIBDataset.SetBufExtended(Field : TField; CurrBuff,Buffer : pointer);
+var
+  E    : extended;
+  D    : double;
+  S    : single;
+begin
+  case Field.Size of
+    4    : 
+      begin
+        Move(CurrBuff^,S,4);
+        E := S;
+      end;
+    8    :
+      begin
+        Move(CurrBuff^,D,8);
+        E := D;
+      end;
+    10   : Move(CurrBuff^,E,10);
+  end;
+  Move(E, Buffer^, 10);
+end;
+
+procedure TIBDataset.SetBufInteger(Field : TField; CurrBuff,Buffer : pointer);
+var
+  I    : integer;
+begin
+  I := 0;
+  Move(I, Buffer^, SizeOf(Integer));
+  Move(CurrBuff^, Buffer^, Field.Size);
+end;
+
+procedure TIBDataset.SetBufDateTime(Field : TField; CurrBuff,Buffer : pointer; AType : integer);
+var
+  D    : TDateTime;
+  S    : TSystemTime;
+  TM   : TTm;
+  TT   : TIsc_timestamp;
+begin
+  case AType of
+    SQL_TYPE_DATE: 
+      isc_decode_sql_date(PISC_DATE(CurrBuff), @TM);
+    SQL_TYPE_TIME:
+      isc_decode_sql_time(PISC_TIME(CurrBuff), @TM);
+    SQL_TIMESTAMP, SQL_TIMESTAMP+1:
+      isc_decode_timestamp(PISC_TIMESTAMP(CurrBuff), @TM);
+  end;
+  S.Year := TM.tm_year + 1900;
+  S.Month := TM.tm_mon + 1;
+  S.Day := TM.tm_mday;
+  S.Hour := TM.tm_hour;
+  S.Minute := TM.tm_min;
+  S.Second := TM.tm_sec;
+  S.Millisecond := 0;
+  D := SystemTimeToDateTime(S);
+  {$warning !!! D is okay, but Field.AsDateTime returns wrong value !!! } 
+//  WriteLn(DateTimeToStr(D));
+  Move(D, Buffer^, SizeOf(D));
+end;
+
+procedure TIBDataset.SetBufString(Field : TField; CurrBuff,Buffer : pointer);
+begin
+  Move(CurrBuff^, Buffer^, Field.Size);
+  PChar(Buffer + Field.Size)^ := #0;
+end;
+
+function TIBDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
+var
+  x        : longint;
+  CurrBuff : PChar;
+begin
+  Result := False;
+  CurrBuff := ActiveBuffer;
+  for x := 0 to FSQLDA^.SQLD - 1 do
+  begin
+    if (Field.FieldName = FSQLDA^.SQLVar[x].SQLName) then
+    begin
+
+      case Field.DataType of
+        ftFloat:  
+          SetBufExtended(Field, CurrBuff, Buffer);
+        ftString: 
+          SetBufString(Field, CurrBuff, Buffer);
+        ftDate,ftTime,ftDateTime:
+          SetBufDateTime(Field, CurrBuff, Buffer, FSQLDA^.SQLVar[x].SQLType);
+        ftInteger:
+          SetBufInteger(Field, CurrBuff, Buffer);
+      end;
+
+      Result := True;
+
+      break; 
+    end
+    else Inc(CurrBuff, FSQLDA^.SQLVar[x].SQLLen);
+  end;
+end;
+
+function TIBDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
+begin
+  if FCurrStmtType <> stResult then Exit;
+  if FIsEOF then 
+    Result := grEOF
+  else begin
+	Result := grOk;
+    case GetMode of
+	  gmPrior: 
+		if FCurrentRecord <= 0 then
+		begin
+		  Result := grBOF;
+		  FCurrentRecord := -1;
+		end
+		else Dec(FCurrentRecord);
+	  gmCurrent:
+		if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
+		  Result := grError;
+      gmNext: 
+		if FCurrentRecord >= (RecordCount - 1) then
+        begin
+		  Result := LoadBufferFromData(Buffer);
+          if Result = grOk then 
+          begin
+            Inc(FCurrentRecord);
+            Inc(FRecordCount);
+          end;
+        end
+		else Inc(FCurrentRecord);
+    end;
+
+    if Result = grOK then
+    begin
+      with PIBBookmark(Buffer + FRecordSize)^ do
+      begin
+        BookmarkData := FCurrentRecord;
+        BookmarkFlag := bfCurrent;
+      end;               
+    end
+    else if (Result = grError) {and (DoCheck)} then
+      DatabaseError('No record');
+  end;
+end;
+
+function TIBDataset.GetRecordCount: integer;
+begin
+  Result := FRecordCount;
+end;
+
+function TIBDataset.GetRecordSize: Word;
+begin
+  Result := FRecordSize;
+end;
+
+procedure TIBDataset.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
+begin
+end;
+
+procedure TIBDataset.InternalClose;
+begin
+  DoFreeBuffers;
+  DoStmtDealloc;
+  if DefaultFields then
+    DestroyFields;
+  FIsEOF := False;
+  FCurrentRecord := -1;
+  FBufferSize := 0;
+  FRecordSize := 0;
+  FRecordCount := 0;
+//  DoSQLDAAlloc(50);
+end;
+
+procedure TIBDataset.InternalDelete;
+begin
+end;
+
+procedure TIBDataset.InternalFirst;
+begin
+  FCurrentRecord := -1;
+end;
+
+procedure TIBDataset.InternalGotoBookmark(ABookmark: Pointer);
+begin
+  FCurrentRecord := PInteger(ABookmark)^;
+end;
+
+procedure TIBDataset.InternalHandleException;
+begin
+  // not implemented
+end;
+
+procedure TIBDataset.InternalInitFieldDefs;
+var
+  x       : longint;
+  TransFt : TFieldType;
+  TransSz : word;
+begin
+  if FLoadingFieldDefs then 
+  begin
+    WriteLn('Loading FieldDefs...');
+    Exit;
+  end;
+  
+  FLoadingFieldDefs := True;
+  
+  try
+    try
+      FieldDefs.Clear;
+      for x := 0 to FSQLDA^.SQLD - 1 do
+      begin
+        TranslateFieldType(FSQLDA^.SQLVar[x].SQLType, FSQLDA^.SQLVar[x].SQLLen,
+          TransFt, TransSz);
+        TFieldDef.Create(FieldDefs,
+          FSQLDA^.SQLVar[x].SQLName, 
+          TransFt, TransSz, False, (x+1));
+      end;
+    finally
+    end;
+  finally
+    FLoadingFieldDefs := False;
+  end;
+end;
+
+procedure TIBDataset.InternalInitRecord(Buffer: PChar);
+begin
+  FillChar(Buffer^, FBufferSize, #0);
+end;
+
+procedure TIBDataset.InternalLast;
+begin
+  FCurrentRecord := RecordCount;
+end;
+
+procedure TIBDataset.InternalOpen;
+begin
+  try
+    DoStmtAlloc;
+    DoParseSQL;
+    if FCurrStmtType = stResult then
+    begin
+      DoAssignBuffers;
+      DoExecSQL;
+      InternalInitFieldDefs;
+      if DefaultFields then
+        CreateFields;
+      SetSizes;
+      BindFields(True);
+    end
+    else DoExecSQL;
+  except
+	raise;
+  end;
+  
+end;
+
+procedure TIBDataset.InternalPost;
+begin
+end;
+
+procedure TIBDataset.InternalSetToRecord(Buffer: PChar);
+begin
+  FCurrentRecord := PIBBookmark(Buffer + FRecordSize)^.BookmarkData;
+end;
+
+function TIBDataset.IsCursorOpen: Boolean;
+begin
+  Result := FStatementHandle <> nil; //??
+end;
+
+procedure TIBDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
+begin
+  PIBBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
+end;
+
+procedure TIBDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
+begin
+  PIBBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
+end;
+
+procedure TIBDataset.SetFieldData(Field: TField; Buffer: Pointer);
+begin
+end;
+
+// PUBLIC PART
+
+constructor TIBDataset.Create(AOwner : TComponent);
+begin
+  inherited Create(AOwner);
+  FSQL := TStringList.Create;
+  FIsEOF := False;
+  FCurrentRecord := -1;
+  FBufferSize := 0;
+  FRecordSize := 0;
+  FRecordCount := 0;
+  DoSQLDAAlloc(50);
+end;
+
+destructor TIBDataset.Destroy;
+begin
+  FSQL.Free;
+  inherited Destroy;
+  FreeMem(FSQLDA, XSQLDA_Length * FSQLDAAllocated);
+end;
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-06-04 08:15:42  michael
+  + Initial implementation in FCL
+
+  Revision 1.1.1.1  2000/06/02 06:56:37  stingp1
+  Initial release
+
+} 

+ 48 - 0
fcl/db/interbase/mkdb

@@ -0,0 +1,48 @@
+#!/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=testdb.gdb
+# Choose one of the following:
+# ISQL=isql
+ISQL=/usr/interbase/bin/isql
+#
+# Don't edit after this.
+#
+echo -n "Creating and filling table FPdev in database $DATABASE..."
+# >/dev/null 2>&1
+${ISQL} << EOF
+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."
+else
+  echo "Done."
+fi
+# Ready

+ 75 - 0
fcl/db/interbase/testib.pp

@@ -0,0 +1,75 @@
+// $Id$
+
+// Test program for interbase.pp unit
+
+program testib;
+
+uses Interbase,SysUtils,db;
+
+{$linklib dl}
+{$linklib crypt}
+
+const
+  dbpath = 'obelix.wisa.be:/home/interbase/helpdesk.gdb';
+  
+var
+  DBS : TIBDatabase;
+  DS : TIBDataset;
+  x  : integer;
+  S  : TSystemTime;
+
+begin
+  DBS := TIBDatabase.Create(nil);
+  DS := TIBDataset.Create(nil);
+  DS.Database := DBS;
+  DBS.DatabaseName := dbpath;
+  DBS.UserName := 'SYSDBA';
+  DBS.Password := 'masterkey';
+  DBS.Connected:=True;
+  DS.SQL.Add('select * from scholen');
+  DS.Open;
+  while not DS.EOF do
+  begin
+    for x := 0 to DS.FieldCount - 2 do
+      Write(DS.Fields[x].AsString,',');
+    WriteLn(DS.Fields[DS.FieldCount-1].AsString);
+    DS.Next;
+  end;
+  DS.Close;
+  DS.SQL.Clear;
+  DS.Free;
+{
+  WriteLn;
+  WriteLn('Trying to perform test of datatypes interpretation...');
+  WriteLn('Some problems with TDateTimeField, see source');
+  DS := TIBDataset.Create(nil);
+  DS.Database := DBS;
+  DS.SQL.Add('select * from test');
+  DS.Open;
+  while not DS.EOF do
+  begin
+    { Warning - TDateTimeField.AsDateTime returns wrong values,
+      but conversions in TIBDataset are OK! }
+    for x := 0 to DS.FieldCount - 1 do
+      if (DS.Fields[x].DataType = ftDateTime) then
+        WriteLn(DS.Fields[x].FieldName, ' : "',
+          FormatDateTime('DD.MM.YYYY HH:MM:SS',DS.Fields[x].AsDateTime),'"')
+      else WriteLn(DS.Fields[x].FieldName, ' : "',DS.Fields[x].AsString,'"');
+    DS.Next;
+  end;
+  DS.Free;
+}
+  DBS.EndTransaction;
+  DBS.Close;
+  DBS.Free;
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-06-04 08:15:43  michael
+  + Initial implementation in FCL
+
+  Revision 1.1.1.1  2000/06/02 06:56:37  stingp1
+  Initial release
+
+}