mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-05 23:07:14 +01:00
* Added ms-sql server connector by LaCak2
git-svn-id: trunk@20522 -
This commit is contained in:
michael
parent
639aa0c0c2
commit
5331e66a8d
10
.gitattributes
vendored
10
.gitattributes
vendored
@ -1618,6 +1618,10 @@ packages/cocoaint/utils/uikit-skel/src/opengles/OpenGLES.inc svneol=native#text/
|
||||
packages/cocoaint/utils/uikit-skel/src/patches/NSObjCRuntime.patch svneol=native#text/plain
|
||||
packages/cocoaint/utils/uikit-skel/src/quartzcore/QuartzCore.inc svneol=native#text/plain
|
||||
packages/cocoaint/utils/uikit-skel/src/uikit/UIKit.inc svneol=native#text/plain
|
||||
packages/dblib/Makefile svneol=native#text/plain
|
||||
packages/dblib/Makefile.fpc svneol=native#text/plain
|
||||
packages/dblib/fpmake.pp svneol=native#text/plain
|
||||
packages/dblib/src/dblib.pp svneol=native#text/plain
|
||||
packages/dbus/Makefile svneol=native#text/plain
|
||||
packages/dbus/Makefile.fpc svneol=native#text/plain
|
||||
packages/dbus/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||
@ -1958,6 +1962,12 @@ packages/fcl-db/src/sqldb/interbase/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/interbase/fpmake.inc svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/interbase/fpmake.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/interbase/ibconnection.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mssql/Makefile svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mssql/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mssql/fpmake.inc svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mssql/fpmake.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mssql/readme.txt svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mysql/Makefile svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mysql/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-db/src/sqldb/mysql/fpmake.inc svneol=native#text/plain
|
||||
|
||||
2160
packages/dblib/Makefile
Normal file
2160
packages/dblib/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
76
packages/dblib/Makefile.fpc
Normal file
76
packages/dblib/Makefile.fpc
Normal file
@ -0,0 +1,76 @@
|
||||
#
|
||||
# Makefile.fpc for running fpmake
|
||||
#
|
||||
|
||||
[package]
|
||||
name=dblib
|
||||
version=2.7.1
|
||||
|
||||
[require]
|
||||
packages=rtl fpmkunit
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../..
|
||||
|
||||
[prerules]
|
||||
FPMAKE_BIN_CLEAN=$(wildcard .$(PATHSEP)fpmake$(SRCEXEEXT))
|
||||
ifdef OS_TARGET
|
||||
FPC_TARGETOPT+=--os=$(OS_TARGET)
|
||||
endif
|
||||
ifdef CPU_TARGET
|
||||
FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
|
||||
endif
|
||||
LOCALFPMAKE=.$(PATHSEP)fpmake$(SRCEXEEXT)
|
||||
|
||||
[rules]
|
||||
.NOTPARALLEL:
|
||||
|
||||
fpmake: fpmake.pp
|
||||
$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT)
|
||||
all: fpmake
|
||||
$(LOCALFPMAKE) compile --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) -bu
|
||||
smart: fpmake
|
||||
$(LOCALFPMAKE) compile --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) -bu -o -XX -o -CX
|
||||
release: fpmake
|
||||
$(LOCALFPMAKE) compile --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) -bu -o -dRELEASE
|
||||
debug: fpmake
|
||||
$(LOCALFPMAKE) compile --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) -bu -o -dDEBUG
|
||||
# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
|
||||
# most often fail because the dependencies are cleared.
|
||||
# In case of a clean, simply do nothing
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
clean:
|
||||
else
|
||||
clean:
|
||||
$(FPMAKE_BIN_CLEAN) clean --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC)
|
||||
endif
|
||||
# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
|
||||
# when the package is compiled using fpcmake prior to running this clean using fpmake
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
distclean: $(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
|
||||
else
|
||||
distclean:
|
||||
ifdef inUnix
|
||||
{ $(FPMAKE_BIN_CLEAN) distclean --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi; }
|
||||
else
|
||||
$(FPMAKE_BIN_CLEAN) distclean --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC)
|
||||
endif
|
||||
-$(DEL) $(LOCALFPMAKE)
|
||||
endif
|
||||
install: fpmake
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
else
|
||||
$(LOCALFPMAKE) install --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) --prefix=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
endif
|
||||
# distinstall also installs the example-sources
|
||||
distinstall: fpmake
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie
|
||||
else
|
||||
$(LOCALFPMAKE) install --localunitdir=../.. --globalunitdir=.. $(FPC_TARGETOPT) $(addprefix -o ,$(FPCOPT)) --compiler=$(FPC) --prefix=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie
|
||||
endif
|
||||
|
||||
39
packages/dblib/fpmake.pp
Normal file
39
packages/dblib/fpmake.pp
Normal file
@ -0,0 +1,39 @@
|
||||
{$ifndef ALLPACKAGES}
|
||||
{$mode objfpc}{$H+}
|
||||
program fpmake;
|
||||
|
||||
uses fpmkunit;
|
||||
|
||||
Const
|
||||
DBLibOSes = [linux,freebsd,netbsd,openbsd,win32];
|
||||
|
||||
Var
|
||||
P : TPackage;
|
||||
T : TTarget;
|
||||
begin
|
||||
With Installer do
|
||||
begin
|
||||
{$endif ALLPACKAGES}
|
||||
|
||||
P:=AddPackage('dblib');
|
||||
{$ifdef ALLPACKAGES}
|
||||
P.Directory:='dblib';
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='1.0';
|
||||
P.Author := 'Library: (FreeTDS/Microsoft), header: Lacack2';
|
||||
P.License := 'Library: FreeTDS License, header: LGPL with modification, ';
|
||||
P.HomepageURL := 'www.freepascal.org';
|
||||
P.Email := '';
|
||||
P.Description := 'Headers for the MS SQL Server RDBMS';
|
||||
P.NeedLibC:= true; // true for headers that indirectly link to libc?
|
||||
|
||||
P.SourcePath.Add('src');
|
||||
P.IncludePath.Add('src');
|
||||
|
||||
T:=P.Targets.AddUnit('dblib.pp',DBLibOSes);
|
||||
|
||||
{$ifndef ALLPACKAGES}
|
||||
Run;
|
||||
end;
|
||||
end.
|
||||
{$endif ALLPACKAGES}
|
||||
594
packages/dblib/src/dblib.pp
Normal file
594
packages/dblib/src/dblib.pp
Normal file
@ -0,0 +1,594 @@
|
||||
{
|
||||
This file is part of the Free Component Library (FCL)
|
||||
|
||||
Copyright (c) 2010 by the Free Pascal development team
|
||||
|
||||
Header files Microsoft DB-Library for C: sqlfront.h, sqldb.h
|
||||
and FreeTDS: sybdb.h
|
||||
|
||||
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.
|
||||
|
||||
The Original Code was created by (c) 2010 Ladislav Karrach (Windows)
|
||||
for the Free Pascal project.
|
||||
**********************************************************************
|
||||
FreeTDS (http://www.freetds.org/userguide/choosingtdsprotocol.htm):
|
||||
tds version = 5.0 - Sybase System 10 and above
|
||||
7.0 - MS SQL Server 7
|
||||
7.1 - MS SQL Server 2000 (*default*)
|
||||
7.2 - MS SQL Server 2005
|
||||
7.3 - MS SQL Server 2008
|
||||
tds version can be set using env.var. TDSVER or in freetds.conf or .freetds.conf
|
||||
}
|
||||
unit dblib;
|
||||
|
||||
{$IFDEF FPC}{$mode objfpc}{$ENDIF}{$H+}
|
||||
|
||||
{ $DEFINE ntwdblib} //if you are using MS SQL Server Client Library (ntwdblib.dll)
|
||||
{$IFNDEF ntwdblib}
|
||||
{$DEFINE freetds} //if you are using db-lib from FreeTDS project (MS SQL Server + Sybase support)
|
||||
{$ENDIF}
|
||||
|
||||
{$DEFINE LOAD_DYNAMICALLY}
|
||||
|
||||
interface
|
||||
|
||||
const
|
||||
DBLIBDLL=
|
||||
{$IFDEF WINDOWS}
|
||||
{$IFDEF ntwdblib}'ntwdblib.dll'{$ENDIF}
|
||||
{$IFDEF freetds} 'dblib.dll' {$ENDIF}
|
||||
{$ELSE}
|
||||
'libsybdb.so'
|
||||
{$ENDIF}
|
||||
;
|
||||
|
||||
//from sybdb.h:
|
||||
//DBVERSION_xxx are used with dbsetlversion()
|
||||
DBVERSION_100= 2; // Sybase TDS 5.0
|
||||
DBVERSION_42 = 3; // This can be used for old Microsoft and Sybase servers
|
||||
DBVERSION_70 = 4;
|
||||
DBVERSION_71 = 5;
|
||||
DBVERSION_72 = 6;
|
||||
DBVERSION_73 = 7;
|
||||
|
||||
//DBTDS_xxx are returned by DBTDS()
|
||||
DBTDS_UNKNOWN= 0;
|
||||
DBTDS_42 = 4; // SQL Server 4.2
|
||||
DBTDS_50 = 7; // Sybase SQL Server 5.0; use this for connecting to Sybase (ASA or ASE)
|
||||
DBTDS_70 = 8; // Microsoft SQL Server 7.0
|
||||
DBTDS_71 = 9; // Microsoft SQL Server 2000
|
||||
DBTDS_72 = 10; // Microsoft SQL Server 2005
|
||||
DBTDS_73 = 11; // Microsoft SQL Server 2008
|
||||
|
||||
//from sqlfront.h:
|
||||
DBSETHOST=1;
|
||||
DBSETUSER=2;
|
||||
DBSETPWD=3;
|
||||
DBSETAPP=4;
|
||||
DBSETID=5;
|
||||
DBSETLANG=6;
|
||||
DBSETSECURE=7;
|
||||
//These two are defined by Microsoft for dbsetlversion():
|
||||
DBVER42={$IFDEF freetds}DBVERSION_42{$ELSE}8{$ENDIF};
|
||||
DBVER60={$IFDEF freetds}DBVERSION_71{$ELSE}9{$ENDIF};
|
||||
DBSET_LOGINTIME=10;
|
||||
DBSETFALLBACK=12;
|
||||
//dboptions:
|
||||
DBNOAUTOFREE = {$IFDEF freetds}15{$ELSE}8{$ENDIF};
|
||||
DBTEXTLIMIT = {$IFDEF freetds}7{$ELSE}4{$ENDIF};
|
||||
DBTEXTSIZE = {$IFDEF freetds}17{$ELSE}5{$ENDIF};
|
||||
DBANSItoOEM = 14;
|
||||
DBOEMtoANSI = 15;
|
||||
DBQUOTEDIDENT= {$IFDEF freetds}35{$ELSE}18{$ENDIF};
|
||||
|
||||
TIMEOUT_IGNORE=-1;
|
||||
TIMEOUT_INFINITE=0;
|
||||
|
||||
SUCCEED=1;
|
||||
FAIL=0;
|
||||
NO_MORE_RESULTS=2;
|
||||
NO_MORE_RPC_RESULTS=3;
|
||||
|
||||
MORE_ROWS=-1;
|
||||
REG_ROW=MORE_ROWS;
|
||||
NO_MORE_ROWS=-2;
|
||||
BUF_FULL=-3; //only if buffering is turned on
|
||||
|
||||
INT_EXIT=0;
|
||||
INT_CONTINUE=1;
|
||||
INT_CANCEL=2;
|
||||
|
||||
SQLVOID=$1f;
|
||||
SQLTEXT=$23;
|
||||
SQLVARBINARY=$25;
|
||||
SQLINTN=$26; //all nullable integers
|
||||
SQLVARCHAR=$27;
|
||||
SQLBINARY=$2d;
|
||||
SQLIMAGE=$22;
|
||||
SQLCHAR=$2f;
|
||||
SQLINT1=$30;
|
||||
SQLBIT=$32;
|
||||
SQLINT2=$34;
|
||||
SQLINT4=$38;
|
||||
SQLMONEY=$3c;
|
||||
SQLDATETIME=$3d;
|
||||
SQLFLT8=$3e;
|
||||
SQLFLTN=$6d;
|
||||
SQLMONEYN=$6e;
|
||||
SQLDATETIMN=$6f;
|
||||
SQLFLT4=$3b;
|
||||
SQLMONEY4=$7a;
|
||||
SQLDATETIM4=$3a;
|
||||
SQLDECIMAL=$6a;
|
||||
SQLNUMERIC=$6c;
|
||||
//from tds.h:
|
||||
SYBNTEXT=$63;
|
||||
SYBINT8=$7F;
|
||||
SYBUNIQUE=$24;
|
||||
//XSYBVARCHAR=$A7;
|
||||
//XSYBNVARCHAR=$E7;
|
||||
//XSYBNCHAR = $EF;
|
||||
//XSYBBINARY= $AD;
|
||||
|
||||
MAXTABLENAME ={$IFDEF freetds}512+1{$ELSE}30{$ENDIF};
|
||||
MAXCOLNAMELEN={$IFDEF freetds}512+1{$ELSE}30{$ENDIF};
|
||||
MAXNUMERICLEN={$IFDEF freetds}32 {$ELSE}16{$ENDIF};
|
||||
DBMAXCHAR=256; // Max length of DBVARBINARY and DBVARCHAR, etc.
|
||||
|
||||
DEFAULTPRECISION = 18;
|
||||
DEFAULTSCALE = 0;
|
||||
|
||||
// Used by dbcolinfo:
|
||||
CI_REGULAR=1;
|
||||
CI_ALTERNATE=2;
|
||||
CI_CURSOR=3;
|
||||
|
||||
DBUNKNOWN = 2; //FALSE = 0, TRUE = 1
|
||||
|
||||
type
|
||||
PLOGINREC=Pointer;
|
||||
PDBPROCESS=Pointer;
|
||||
|
||||
RETCODE=integer;
|
||||
STATUS=integer;
|
||||
|
||||
INT=longint;
|
||||
SHORT=smallint;
|
||||
BOOL=longbool;
|
||||
ULONG=longword;
|
||||
|
||||
// DB-Library datatypes
|
||||
DBCHAR=char;
|
||||
DBTINYINT=byte;
|
||||
DBSMALLINT=smallint;
|
||||
DBINT=longint;
|
||||
DBUSMALLINT=word;
|
||||
DBFLT8=double;
|
||||
DBBIT=byte;
|
||||
DBBINARY=byte;
|
||||
|
||||
{$PACKRECORDS C}
|
||||
DBDATETIME=packed record
|
||||
dtdays: DBINT;
|
||||
dttime: ULONG;
|
||||
end;
|
||||
PDBDATETIME=^DBDATETIME;
|
||||
|
||||
// DBDATEREC structure used by dbdatecrack
|
||||
DBDATEREC=packed record
|
||||
case boolean of
|
||||
false:(
|
||||
oldyear:INT; // 1753 - 9999
|
||||
oldmonth: INT; // 1 - 12
|
||||
oldday: INT; // 1 - 31
|
||||
olddayofyear: INT; // 1 - 366 (in sybdb.h dayofyear and day are changed around!)
|
||||
oldweekday: INT; // 1 - 7 (Mon - Sun)
|
||||
oldhour: INT; // 0 - 23
|
||||
oldminute: INT; // 0 - 59
|
||||
oldsecond: INT; // 0 - 59
|
||||
oldmillisecond: INT; // 0 - 999
|
||||
oldtzone: INT; // 0 - 127 (Sybase only!)
|
||||
);
|
||||
true:(
|
||||
year:INT; // 1753 - 9999
|
||||
quarter:INT; // 1 - 4
|
||||
month: INT; // 1 - 12
|
||||
{$IFDEF freetds}
|
||||
day: INT; // 1 - 31
|
||||
dayofyear: INT; // 1 - 366 (in sybdb.h dayofyear and day are changed around!)
|
||||
{$ELSE}
|
||||
dayofyear: INT; // 1 - 366 (in sybdb.h dayofyear and day are changed around!)
|
||||
day: INT; // 1 - 31
|
||||
{$ENDIF}
|
||||
week: INT; // 1 - 54 (for leap years)
|
||||
weekday: INT; // 1 - 7 (Mon - Sun)
|
||||
hour: INT; // 0 - 23
|
||||
minute: INT; // 0 - 59
|
||||
second: INT; // 0 - 59
|
||||
millisecond: INT; // 0 - 999
|
||||
tzone: INT; // 0 - 127 (Sybase only!)
|
||||
);
|
||||
end;
|
||||
PDBDATEREC=^DBDATEREC;
|
||||
|
||||
DBNUMERIC=packed record
|
||||
precision: BYTE;
|
||||
scale: BYTE;
|
||||
sign: BYTE; // 1 = Positive, 0 = Negative
|
||||
val: array[0..MAXNUMERICLEN-1] of BYTE;
|
||||
end;
|
||||
|
||||
DBVARYBIN=packed record
|
||||
len: {$IFDEF freetds}DBINT{$ELSE}DBSMALLINT{$ENDIF};
|
||||
bytes: array[0..DBMAXCHAR-1] of BYTE;
|
||||
end;
|
||||
|
||||
DBVARYCHAR=packed record
|
||||
len: {$IFDEF freetds}DBINT{$ELSE}DBSMALLINT{$ENDIF};
|
||||
str: array[0..DBMAXCHAR-1] of CHAR;
|
||||
end;
|
||||
|
||||
DBERRHANDLE_PROC=function(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PChar):INT; cdecl;
|
||||
DBMSGHANDLE_PROC=function(dbproc: PDBPROCESS; msgno: DBINT; msgstate, severity:INT; msgtext, srvname, procname:PChar; line:DBUSMALLINT):INT; cdecl;
|
||||
|
||||
{$IFDEF ntwdblib}
|
||||
{$PACKRECORDS 2}
|
||||
{$ENDIF}
|
||||
DBCOL=record
|
||||
SizeOfStruct: DBINT;
|
||||
Name: array[0..MAXCOLNAMELEN] of char;
|
||||
ActualName: array[0..MAXCOLNAMELEN] of char;
|
||||
TableName: array[0..MAXTABLENAME] of char;
|
||||
Typ: SHORT;
|
||||
UserType: DBINT;
|
||||
MaxLength: DBINT;
|
||||
Precision: BYTE;
|
||||
Scale: BYTE;
|
||||
VarLength: BOOL; // TRUE, FALSE
|
||||
Null: BYTE; // TRUE, FALSE or DBUNKNOWN
|
||||
CaseSensitive: BYTE; // TRUE, FALSE or DBUNKNOWN
|
||||
Updatable: BYTE; // TRUE, FALSE or DBUNKNOWN
|
||||
Identity: BOOL; // TRUE, FALSE
|
||||
end;
|
||||
PDBCOL=^DBCOL;
|
||||
{$PACKRECORDS DEFAULT}
|
||||
|
||||
|
||||
var
|
||||
DBLibInit: boolean=false; //was dbinit() already called ?
|
||||
|
||||
{$IFNDEF LOAD_DYNAMICALLY}
|
||||
function dbinit():{$IFDEF freetds}RETCODE{$ELSE}PChar{$ENDIF}; cdecl; external DBLIBDLL;
|
||||
function dblogin():PLOGINREC; cdecl; external DBLIBDLL;
|
||||
function dbsetlname(login:PLOGINREC; value:PChar; which:INT):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbsetlogintime(seconds:INT):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbsettime(seconds:INT):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dberrhandle(handler:DBERRHANDLE_PROC):DBERRHANDLE_PROC; cdecl; external DBLIBDLL;
|
||||
function dbmsghandle(handler:DBMSGHANDLE_PROC):DBMSGHANDLE_PROC; cdecl; external DBLIBDLL;
|
||||
function dbsetopt(dbproc:PDBPROCESS; option: INT; param:PChar {$IFDEF freetds};int_param:INT{$ENDIF}):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbuse(dbproc:PDBPROCESS; dbname:PChar):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbcmd(dbproc:PDBPROCESS; cmdstring:PChar):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbcmdrow(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbsqlexec(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbresults(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbmorecmds(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbnextrow(dbproc:PDBPROCESS):STATUS; cdecl; external DBLIBDLL;
|
||||
function dbnumcols(dbproc:PDBPROCESS):INT; cdecl; external DBLIBDLL;
|
||||
function dbcolname(dbproc:PDBPROCESS; column:INT):PChar; cdecl; external DBLIBDLL;
|
||||
function dbcoltype(dbproc:PDBPROCESS; column:INT):INT; cdecl; external DBLIBDLL;
|
||||
function dbcollen(dbproc:PDBPROCESS; column:INT):DBINT; cdecl; external DBLIBDLL;
|
||||
function dbcolinfo(dbproc:PDBPROCESS; typ:INT; column:DBINT; computeid:DBINT; dbcol:PDBCOL):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbprtype(token:INT):PChar; cdecl; external DBLIBDLL;
|
||||
function dbdatlen(dbproc:PDBPROCESS; column:INT):DBINT; cdecl; external DBLIBDLL;
|
||||
function dbdata(dbproc:PDBPROCESS; column:INT):PByte; cdecl; external DBLIBDLL;
|
||||
function dbconvert(dbproc:PDBPROCESS; srctype:INT; src:PByte; srclen:DBINT; desttype:INT; dest:PByte; destlen:DBINT):INT; cdecl; external DBLIBDLL;
|
||||
function dbdatecrack(dbproc:PDBPROCESS; dateinfo:PDBDATEREC; datetime: PDBDATETIME):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbcount(dbproc:PDBPROCESS):DBINT; cdecl; external DBLIBDLL;
|
||||
function dbiscount(dbproc:PDBPROCESS):BOOL; cdecl; external DBLIBDLL;
|
||||
function dbcancel(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbcanquery(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
|
||||
procedure dbfreelogin(login:PLOGINREC); cdecl; external DBLIBDLL {$IFDEF freetds}name 'dbloginfree'{$ENDIF};
|
||||
procedure dbexit(); cdecl; external DBLIBDLL;
|
||||
{$IFDEF ntwdblib}
|
||||
function dbopen(login:PLOGINREC; servername:PChar):PDBPROCESS; cdecl; external DBLIBDLL;
|
||||
function dbclose(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
|
||||
procedure dbwinexit; cdecl; external DBLIBDLL;
|
||||
{$ENDIF}
|
||||
{$IFDEF freetds}
|
||||
function tdsdbopen(login:PLOGINREC; servername:PChar; msdblib:INT):PDBPROCESS; cdecl; external DBLIBDLL;
|
||||
function dbtablecolinfo(dbproc:PDBPROCESS; column:DBINT; dbcol:PDBCOL):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbtds(dbproc:PDBPROCESS):INT; cdecl; external DBLIBDLL;
|
||||
function dbsetlversion(login:PLOGINREC; version:BYTE):RETCODE; cdecl; external DBLIBDLL;
|
||||
function dbservcharset(dbproc:PDBPROCESS):PChar; cdecl; external DBLIBDLL;
|
||||
procedure dbclose(dbproc:PDBPROCESS); cdecl; external DBLIBDLL;
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
var
|
||||
dbinit: function():{$IFDEF freetds}RETCODE{$ELSE}PChar{$ENDIF}; cdecl;
|
||||
dblogin: function():PLOGINREC; cdecl;
|
||||
dbsetlname: function(login:PLOGINREC; value:PChar; which:INT):RETCODE; cdecl;
|
||||
dbsetlogintime: function(seconds:INT):RETCODE; cdecl;
|
||||
dbsettime: function(seconds:INT):RETCODE; cdecl;
|
||||
dberrhandle: function(handler:DBERRHANDLE_PROC):DBERRHANDLE_PROC; cdecl;
|
||||
dbmsghandle: function(handler:DBMSGHANDLE_PROC):DBMSGHANDLE_PROC; cdecl;
|
||||
dbsetopt: function(dbproc:PDBPROCESS; option: INT; param:PChar {$IFDEF freetds};int_param:INT{$ENDIF}):RETCODE; cdecl;
|
||||
dbuse: function(dbproc:PDBPROCESS; dbname:PChar):RETCODE; cdecl;
|
||||
dbcmd: function(dbproc:PDBPROCESS; cmdstring:PChar):RETCODE; cdecl;
|
||||
dbcmdrow: function(dbproc:PDBPROCESS):RETCODE; cdecl;
|
||||
dbsqlexec: function(dbproc:PDBPROCESS):RETCODE; cdecl;
|
||||
dbresults: function(dbproc:PDBPROCESS):RETCODE; cdecl;
|
||||
dbmorecmds: function(dbproc:PDBPROCESS):RETCODE; cdecl;
|
||||
dbnextrow: function(dbproc:PDBPROCESS):STATUS; cdecl;
|
||||
dbnumcols: function(dbproc:PDBPROCESS):INT; cdecl;
|
||||
dbcolname: function(dbproc:PDBPROCESS; column:INT):PChar; cdecl;
|
||||
dbcoltype: function(dbproc:PDBPROCESS; column:INT):INT; cdecl;
|
||||
dbcollen: function(dbproc:PDBPROCESS; column:INT):DBINT; cdecl;
|
||||
dbcolinfo: function(dbproc:PDBPROCESS; typ:INT; column:DBINT; computeid:DBINT; dbcol:PDBCOL):RETCODE; cdecl;
|
||||
dbprtype: function(token:INT):PChar; cdecl;
|
||||
dbdatlen: function(dbproc:PDBPROCESS; column:INT):DBINT; cdecl;
|
||||
dbdata: function(dbproc:PDBPROCESS; column:INT):PByte; cdecl;
|
||||
dbconvert: function(dbproc:PDBPROCESS; srctype:INT; src:PByte; srclen:DBINT; desttype:INT; dest:PByte; destlen:DBINT):INT; cdecl;
|
||||
dbdatecrack: function(dbproc:PDBPROCESS; dateinfo:PDBDATEREC; datetime: PDBDATETIME):RETCODE; cdecl;
|
||||
dbcount: function(dbproc:PDBPROCESS):DBINT; cdecl;
|
||||
dbiscount: function(dbproc:PDBPROCESS):BOOL; cdecl;
|
||||
dbcancel: function(dbproc:PDBPROCESS):RETCODE; cdecl;
|
||||
dbcanquery: function(dbproc:PDBPROCESS):RETCODE; cdecl;
|
||||
dbexit: procedure(); cdecl;
|
||||
dbfreelogin: procedure(login:PLOGINREC); cdecl;
|
||||
{$IFDEF ntwdblib}
|
||||
dbopen: function(login:PLOGINREC; servername:PChar):PDBPROCESS; cdecl;
|
||||
dbclose: function(dbproc:PDBPROCESS):RETCODE; cdecl;
|
||||
dbwinexit: procedure; cdecl;
|
||||
{$ENDIF}
|
||||
{$IFDEF freetds}
|
||||
tdsdbopen: function(login:PLOGINREC; servername:PChar; msdblib:INT):PDBPROCESS; cdecl;
|
||||
dbtablecolinfo: function(dbproc:PDBPROCESS; column:DBINT; dbcol:PDBCOL):RETCODE; cdecl;
|
||||
dbtds: function(dbproc:PDBPROCESS):INT; cdecl;
|
||||
dbsetlversion: function(login:PLOGINREC; version:BYTE):RETCODE; cdecl;
|
||||
dbservcharset: function(dbproc:PDBPROCESS):PChar; cdecl;
|
||||
dbclose: procedure(dbproc:PDBPROCESS); cdecl;
|
||||
{$ENDIF}
|
||||
|
||||
DefaultDBLibLibraryName: String = DBLIBDLL;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF ntwdblib}
|
||||
function tdsdbopen(login:PLOGINREC; servername:PChar; msdblib:INT):PDBPROCESS;
|
||||
function dbtablecolinfo(dbproc:PDBPROCESS; column:DBINT; dbcol:PDBCOL):RETCODE;
|
||||
function dbsetlversion(login:PLOGINREC; version:BYTE):RETCODE;
|
||||
function dbtds(dbproc:PDBPROCESS):INT;
|
||||
function dbversion():PChar;
|
||||
{$ENDIF}
|
||||
{$IFDEF freetds}
|
||||
function dbopen(login:PLOGINREC; servername:PChar):PDBPROCESS;
|
||||
procedure dbwinexit;
|
||||
{$ENDIF}
|
||||
function dbsetlcharset(login:PLOGINREC; charset:PChar):RETCODE;
|
||||
function dbsetlsecure(login:PLOGINREC):RETCODE;
|
||||
|
||||
procedure InitialiseDBLib(LibraryName : string = '');
|
||||
procedure ReleaseDBLib;
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF LOAD_DYNAMICALLY}
|
||||
uses SysUtils, Dynlibs;
|
||||
|
||||
var DBLibLibraryHandle: TLibHandle;
|
||||
RefCount: integer;
|
||||
|
||||
procedure InitialiseDBLib(LibraryName : string);
|
||||
var libname : string;
|
||||
begin
|
||||
inc(RefCount);
|
||||
if RefCount = 1 then
|
||||
begin
|
||||
if LibraryName='' then
|
||||
libname:=DefaultDBLibLibraryName
|
||||
else
|
||||
libname:=LibraryName;
|
||||
DBLibLibraryHandle := LoadLibrary(libname);
|
||||
if DBLibLibraryHandle = nilhandle then
|
||||
begin
|
||||
RefCount := 0;
|
||||
raise EInOutError.CreateFmt('Can not load DB-Lib client library "%s". Check your installation.'#13'%s',
|
||||
[libname, SysErrorMessage(GetLastOSError)]);
|
||||
end;
|
||||
|
||||
pointer(dbinit) := GetProcedureAddress(DBLibLibraryHandle,'dbinit');
|
||||
pointer(dblogin) := GetProcedureAddress(DBLibLibraryHandle,'dblogin');
|
||||
pointer(dbsetlname) := GetProcedureAddress(DBLibLibraryHandle,'dbsetlname');
|
||||
pointer(dbsetlogintime) := GetProcedureAddress(DBLibLibraryHandle,'dbsetlogintime');
|
||||
pointer(dbsettime) := GetProcedureAddress(DBLibLibraryHandle,'dbsettime');
|
||||
pointer(dberrhandle) := GetProcedureAddress(DBLibLibraryHandle,'dberrhandle');
|
||||
pointer(dbmsghandle) := GetProcedureAddress(DBLibLibraryHandle,'dbmsghandle');
|
||||
pointer(dbsetopt) := GetProcedureAddress(DBLibLibraryHandle,'dbsetopt');
|
||||
pointer(dbuse) := GetProcedureAddress(DBLibLibraryHandle,'dbuse');
|
||||
pointer(dbcmd) := GetProcedureAddress(DBLibLibraryHandle,'dbcmd');
|
||||
pointer(dbcmdrow) := GetProcedureAddress(DBLibLibraryHandle,'dbcmdrow');
|
||||
pointer(dbsqlexec) := GetProcedureAddress(DBLibLibraryHandle,'dbsqlexec');
|
||||
pointer(dbresults) := GetProcedureAddress(DBLibLibraryHandle,'dbresults');
|
||||
pointer(dbmorecmds) := GetProcedureAddress(DBLibLibraryHandle,'dbmorecmds');
|
||||
pointer(dbnextrow) := GetProcedureAddress(DBLibLibraryHandle,'dbnextrow');
|
||||
pointer(dbnumcols) := GetProcedureAddress(DBLibLibraryHandle,'dbnumcols');
|
||||
pointer(dbcolname) := GetProcedureAddress(DBLibLibraryHandle,'dbcolname');
|
||||
pointer(dbcoltype) := GetProcedureAddress(DBLibLibraryHandle,'dbcoltype');
|
||||
pointer(dbcollen) := GetProcedureAddress(DBLibLibraryHandle,'dbcollen');
|
||||
pointer(dbcolinfo) := GetProcedureAddress(DBLibLibraryHandle,'dbcolinfo');
|
||||
pointer(dbprtype) := GetProcedureAddress(DBLibLibraryHandle,'dbprtype');
|
||||
pointer(dbdatlen) := GetProcedureAddress(DBLibLibraryHandle,'dbdatlen');
|
||||
pointer(dbdata) := GetProcedureAddress(DBLibLibraryHandle,'dbdata');
|
||||
pointer(dbconvert) := GetProcedureAddress(DBLibLibraryHandle,'dbconvert');
|
||||
pointer(dbdatecrack) := GetProcedureAddress(DBLibLibraryHandle,'dbdatecrack');
|
||||
pointer(dbcount) := GetProcedureAddress(DBLibLibraryHandle,'dbcount');
|
||||
pointer(dbiscount) := GetProcedureAddress(DBLibLibraryHandle,'dbiscount');
|
||||
pointer(dbcancel) := GetProcedureAddress(DBLibLibraryHandle,'dbcancel');
|
||||
pointer(dbcanquery) := GetProcedureAddress(DBLibLibraryHandle,'dbcanquery');
|
||||
pointer(dbexit) := GetProcedureAddress(DBLibLibraryHandle,'dbexit');
|
||||
pointer(dbfreelogin) := GetProcedureAddress(DBLibLibraryHandle,{$IFDEF freetds}'dbloginfree'{$ELSE}'dbfreelogin'{$ENDIF});
|
||||
pointer(dbclose) := GetProcedureAddress(DBLibLibraryHandle,'dbclose');
|
||||
{$IFDEF ntwdblib}
|
||||
pointer(dbopen) := GetProcedureAddress(DBLibLibraryHandle,'dbopen');
|
||||
pointer(dbwinexit) := GetProcedureAddress(DBLibLibraryHandle,'dbwinexit');
|
||||
{$ENDIF}
|
||||
{$IFDEF freetds}
|
||||
pointer(tdsdbopen) := GetProcedureAddress(DBLibLibraryHandle,'tdsdbopen');
|
||||
pointer(dbtablecolinfo) := GetProcedureAddress(DBLibLibraryHandle,'dbtablecolinfo');
|
||||
pointer(dbtds) := GetProcedureAddress(DBLibLibraryHandle,'dbtds');
|
||||
pointer(dbsetlversion) := GetProcedureAddress(DBLibLibraryHandle,'dbsetlversion');
|
||||
pointer(dbservcharset) := GetProcedureAddress(DBLibLibraryHandle,'dbservcharset');
|
||||
//if not assigned(dbiscount) then
|
||||
// raise EInOutError.Create('Minimum supported version of FreeTDS client library is 0.91!');
|
||||
{$ENDIF}
|
||||
DBLibInit:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ReleaseDBLib;
|
||||
begin
|
||||
if RefCount > 0 then dec(RefCount);
|
||||
if RefCount = 0 then
|
||||
begin
|
||||
dbexit;{$IFDEF WINDOWS}dbwinexit;{$ENDIF}
|
||||
if UnloadLibrary(DBLibLibraryHandle) then
|
||||
DBLibLibraryHandle := NilHandle
|
||||
else
|
||||
inc(RefCount);
|
||||
end;
|
||||
end;
|
||||
{$ELSE}
|
||||
procedure InitialiseDBLib(LibraryName : string);
|
||||
begin
|
||||
//no-op for static linked
|
||||
end;
|
||||
|
||||
procedure ReleaseDBLib;
|
||||
begin
|
||||
//no-op for static linked
|
||||
end;
|
||||
{$ENDIF LOAD_DYNAMICALLY}
|
||||
|
||||
//functions, which are not implemented by FreeTDS:
|
||||
{$IFDEF freetds}
|
||||
function dbopen(login:PLOGINREC; servername:PChar):PDBPROCESS;
|
||||
begin
|
||||
Result:=tdsdbopen(login, servername, 1{1=MSDBLIB or 0=SYBDBLIB});
|
||||
end;
|
||||
|
||||
function dbsetlcharset(login:PLOGINREC; charset:PChar):RETCODE;
|
||||
begin
|
||||
Result:=dbsetlname(login, charset, 10);
|
||||
end;
|
||||
|
||||
function dbsetlsecure(login:PLOGINREC):RETCODE;
|
||||
begin
|
||||
//not implemented; see http://www.freetds.org/userguide/domains.htm
|
||||
Result:=SUCCEED;
|
||||
end;
|
||||
|
||||
procedure dbwinexit;
|
||||
begin
|
||||
//do nothing
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
//functions which are not implemented by ntwdblib:
|
||||
{$IFDEF ntwdblib}
|
||||
function tdsdbopen(login:PLOGINREC; servername:PChar; msdblib:INT):PDBPROCESS;
|
||||
begin
|
||||
Result:=dbopen(login, servername);
|
||||
end;
|
||||
|
||||
function dbtablecolinfo(dbproc:PDBPROCESS; column:DBINT; dbcol:PDBCOL):RETCODE;
|
||||
begin
|
||||
Result:=dbcolinfo(dbproc, CI_REGULAR, column, 0, dbcol);
|
||||
if dbcol^.VarLength {true also when column is nullable} then
|
||||
case dbcol^.Typ of
|
||||
SQLCHAR : dbcol^.Typ := SQLVARCHAR;
|
||||
SQLBINARY: dbcol^.Typ := SQLVARBINARY;
|
||||
end;
|
||||
end;
|
||||
|
||||
function dbsetlversion(login:PLOGINREC; version:BYTE):RETCODE;
|
||||
begin
|
||||
Result:=dbsetlname(login, nil, version);
|
||||
end;
|
||||
|
||||
function dbsetlcharset(login:PLOGINREC; charset:PChar):RETCODE;
|
||||
begin
|
||||
Result:=SUCCEED;
|
||||
end;
|
||||
|
||||
function dbsetlsecure(login:PLOGINREC):RETCODE;
|
||||
begin
|
||||
Result:=dbsetlname(login, nil, DBSETSECURE);
|
||||
end;
|
||||
|
||||
function dbtds(dbproc:PDBPROCESS):INT;
|
||||
begin
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
function dbversion():PChar;
|
||||
begin
|
||||
Result:='DB Library version 8.00';
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{
|
||||
//ntwdblib uses low significant values first
|
||||
//freetds uses variable length array (based on precision) see numeric.c: tds_numeric_bytes_per_prec
|
||||
// and starts from high significant values first
|
||||
function dbnumerictobcd(dbnum: DBNUMERIC): TBCD;
|
||||
var i: integer;
|
||||
intval,intbase,intdiv: int64;
|
||||
bcdval,bcdbase,bcddiv, bcd1: TBCD;
|
||||
begin
|
||||
intval:=0;
|
||||
intbase:=1;
|
||||
for i:=0 to 6 do
|
||||
begin
|
||||
intval := intval + dbnum.val[i] * intbase;
|
||||
intbase:= intbase*256;
|
||||
end;
|
||||
bcdval := IntegerToBCD(intval);
|
||||
|
||||
if dbnum.precision > 16 then
|
||||
begin
|
||||
bcdbase := IntegerToBCD(intbase);
|
||||
for i:=7 to length(dbnum.val)-1 do
|
||||
begin
|
||||
BCDMultiply(bcdbase, integer(dbnum.val[i]), bcd1);
|
||||
BCDAdd(bcdval, bcd1, bcdval);
|
||||
BCDMultiply(bcdbase, 256, bcdbase);
|
||||
end;
|
||||
end;
|
||||
|
||||
if dbnum.scale > 18 then
|
||||
begin
|
||||
bcddiv:=IntegerToBCD(int64(1000000000000000000));
|
||||
for i:=19 to dbnum.scale do BCDMultiply(bcddiv, 10, bcddiv);
|
||||
end
|
||||
else
|
||||
begin
|
||||
intdiv:=1;
|
||||
for i:=1 to dbnum.scale do intdiv:=intdiv*10;
|
||||
bcddiv:=IntegerToBCD(intdiv);
|
||||
end;
|
||||
|
||||
BCDDivide(bcdval, bcddiv, Result);
|
||||
if dbnum.sign=0 then BCDNegate(Result);
|
||||
end;
|
||||
}
|
||||
|
||||
{$IFNDEF LOAD_DYNAMICALLY}
|
||||
finalization
|
||||
dbexit; {$IFDEF WINDOWS}dbwinexit;{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
@ -6,15 +6,15 @@
|
||||
main=fcl-db
|
||||
|
||||
[target]
|
||||
dirs_beos=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_linux=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_freebsd=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_darwin=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_beos=interbase postgres mysql odbc oracle sqlite mssql
|
||||
dirs_linux=interbase postgres mysql odbc oracle sqlite mssql
|
||||
dirs_freebsd=interbase postgres mysql odbc oracle sqlite mssql
|
||||
dirs_darwin=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_iphonesim=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_netbsd=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_openbsd=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_win32=interbase postgres mysql odbc oracle sqlite
|
||||
dirs_win64=interbase odbc mysql sqlite
|
||||
dirs_netbsd=interbase postgres mysql odbc oracle sqlite mssql
|
||||
dirs_openbsd=interbase postgres mysql odbc oracle sqlite mssql
|
||||
dirs_win32=interbase postgres mysql odbc oracle sqlite mssql
|
||||
dirs_win64=interbase odbc mysql sqlite mssql
|
||||
dirs_wince=interbase postgres mysql odbc oracle sqlite
|
||||
units=sqldb
|
||||
rsts=sqldb
|
||||
|
||||
@ -18,4 +18,7 @@ T.ResourceStrings:=True;
|
||||
|
||||
{ Interbase/Firebird }
|
||||
{$i interbase/fpmake.inc}
|
||||
|
||||
{ MS SQL }
|
||||
{$i mssql/fpmake.inc}
|
||||
|
||||
2578
packages/fcl-db/src/sqldb/mssql/Makefile
Normal file
2578
packages/fcl-db/src/sqldb/mssql/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
24
packages/fcl-db/src/sqldb/mssql/Makefile.fpc
Normal file
24
packages/fcl-db/src/sqldb/mssql/Makefile.fpc
Normal file
@ -0,0 +1,24 @@
|
||||
#
|
||||
# Makefile.fpc for SQL IBConnection
|
||||
#
|
||||
|
||||
[package]
|
||||
main=fcl-db
|
||||
|
||||
[target]
|
||||
units=mssqlconn
|
||||
|
||||
[require]
|
||||
packages=dblib
|
||||
|
||||
[compiler]
|
||||
options=-S2
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../../../../..
|
||||
|
||||
[rules]
|
||||
.NOTPARALLEL:
|
||||
11
packages/fcl-db/src/sqldb/mssql/fpmake.inc
Normal file
11
packages/fcl-db/src/sqldb/mssql/fpmake.inc
Normal file
@ -0,0 +1,11 @@
|
||||
{ Make DB directory and all subdirectories }
|
||||
{ FULLSQLDB will be defined if included from SQLDB directory alone}
|
||||
{ FULLDB will be defined if included from db directory alone}
|
||||
{ FULLFCL will be defined if included from main FCL directory }
|
||||
|
||||
Targets.ResetDefaults;
|
||||
Targets.DefaultDir:='db/sqldb/mssql';
|
||||
{ Drivers only for the following OSes }
|
||||
Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,linux];
|
||||
T:=Targets.AddUnit('mssqlconn');
|
||||
T.ResourceStrings:=False;
|
||||
20
packages/fcl-db/src/sqldb/mssql/fpmake.pp
Normal file
20
packages/fcl-db/src/sqldb/mssql/fpmake.pp
Normal file
@ -0,0 +1,20 @@
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
program fpmake;
|
||||
|
||||
uses fpmkunit;
|
||||
|
||||
Var
|
||||
T : TTarget;
|
||||
|
||||
begin
|
||||
ChangeDir('../../..');
|
||||
With Installer do
|
||||
begin
|
||||
{$i ../../../fclmake.inc}
|
||||
{$i fpmake.inc}
|
||||
EndPackage;
|
||||
Run;
|
||||
end;
|
||||
end.
|
||||
|
||||
896
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
Normal file
896
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
Normal file
@ -0,0 +1,896 @@
|
||||
{
|
||||
This file is part of the Free Component Library (FCL)
|
||||
|
||||
MS SQL Server connection using DB-Library
|
||||
|
||||
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.
|
||||
|
||||
The Original Code was created by (c) 2010 Ladislav Karrach (Windows)
|
||||
for the Free Pascal project.
|
||||
**********************************************************************
|
||||
|
||||
MS SQL Server Client Library is required (ntwdblib.dll)
|
||||
- or -
|
||||
FreeTDS (dblib.dll)
|
||||
freetds.conf: (http://www.freetds.org/userguide/freetdsconf.htm)
|
||||
[global]
|
||||
tds version = 7.1
|
||||
client charset = UTF-8
|
||||
port = 1433 or instance = ... (optional)
|
||||
dump file = freetds.log (optional)
|
||||
text size = 2147483647 (optional)
|
||||
|
||||
TMSSQLConnection properties:
|
||||
HostName - can be specified also as 'servername:port' or 'servername\instance'
|
||||
CharSet - if you use Microsoft DB-Lib and set to 'UTF-8' then char/varchar fields will be UTF8Encoded/Decoded
|
||||
if you use FreeTDS DB-Lib then you must compile with iconv support (requires libiconv2.dll) or cast char/varchar to nchar/nvarchar in SELECTs
|
||||
Params - "AutoCommit=true" - if you don't want explicitly commit/rollback transactions
|
||||
"TextSize=16777216 - set maximum size of text/image data returned
|
||||
}
|
||||
unit mssqlconn;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, sqldb, db, BufDataset,
|
||||
dblib;
|
||||
|
||||
type
|
||||
|
||||
TClientCharset = (ccNone, ccUTF8, ccISO88591, ccUnknown);
|
||||
|
||||
{ TMSSQLConnection }
|
||||
|
||||
TMSSQLConnection = class(TSQLConnection)
|
||||
private
|
||||
FDBLogin: PLOGINREC;
|
||||
FDBProc : PDBPROCESS;
|
||||
Ftds : integer; // TDS protocol version
|
||||
Fstatus : STATUS; // current result/rows fetch status
|
||||
procedure DBExecute(const cmd: string);
|
||||
function TranslateFldType(SQLDataType: integer): TFieldType;
|
||||
function ClientCharset: TClientCharset;
|
||||
function AutoCommit: boolean;
|
||||
function IsSybase: boolean;
|
||||
protected
|
||||
// Overrides from TSQLConnection
|
||||
function GetHandle:pointer; override;
|
||||
function GetAsSQLText(Param : TParam) : string; overload; override;
|
||||
// - Connect/disconnect
|
||||
procedure DoInternalConnect; override;
|
||||
procedure DoInternalDisconnect; override;
|
||||
// - Handle (de)allocation
|
||||
function AllocateCursorHandle:TSQLCursor; override;
|
||||
procedure DeAllocateCursorHandle(var cursor:TSQLCursor); override;
|
||||
function AllocateTransactionHandle:TSQLHandle; override;
|
||||
// - Statement handling
|
||||
function StrToStatementType(s : string) : TStatementType; override;
|
||||
procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
|
||||
procedure UnPrepareStatement(cursor:TSQLCursor); override;
|
||||
// - Transaction handling
|
||||
function GetTransactionHandle(trans:TSQLHandle):pointer; override;
|
||||
function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
|
||||
function Commit(trans:TSQLHandle):boolean; override;
|
||||
function Rollback(trans:TSQLHandle):boolean; override;
|
||||
procedure CommitRetaining(trans:TSQLHandle); override;
|
||||
procedure RollbackRetaining(trans:TSQLHandle); override;
|
||||
// - Statement execution
|
||||
procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
|
||||
function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
|
||||
// - Result retrieving
|
||||
procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
|
||||
function Fetch(cursor:TSQLCursor):boolean; override;
|
||||
function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
|
||||
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
|
||||
procedure FreeFldBuffers(cursor:TSQLCursor); override;
|
||||
// - UpdateIndexDefs
|
||||
procedure UpdateIndexDefs(IndexDefs:TIndexDefs; TableName:string); override;
|
||||
// - Schema info
|
||||
function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
|
||||
public
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
//property TDS:integer read Ftds;
|
||||
published
|
||||
// Redeclare properties from TSQLConnection
|
||||
property Password;
|
||||
property Transaction;
|
||||
property UserName;
|
||||
property CharSet;
|
||||
property HostName;
|
||||
// Redeclare properties from TDatabase
|
||||
property Connected;
|
||||
property Role;
|
||||
property DatabaseName;
|
||||
property KeepConnection;
|
||||
property LoginPrompt;
|
||||
property Params;
|
||||
property OnLogin;
|
||||
end;
|
||||
|
||||
{ TSybaseConnection }
|
||||
|
||||
TSybaseConnection = class(TMSSQLConnection)
|
||||
public
|
||||
constructor Create(AOwner : TComponent); override;
|
||||
end;
|
||||
|
||||
{ EMSSQLDatabaseError }
|
||||
|
||||
EMSSQLDatabaseError = class(EDatabaseError)
|
||||
public
|
||||
DBErrorCode : integer;
|
||||
end;
|
||||
|
||||
{ TMSSQLConnectionDef }
|
||||
|
||||
TMSSQLConnectionDef = Class(TConnectionDef)
|
||||
Class Function TypeName : String; override;
|
||||
Class Function ConnectionClass : TSQLConnectionClass; override;
|
||||
Class Function Description : String; override;
|
||||
end;
|
||||
|
||||
{ TSybaseConnectionDef }
|
||||
|
||||
TSybaseConnectionDef = Class(TConnectionDef)
|
||||
Class Function TypeName : String; override;
|
||||
Class Function ConnectionClass : TSQLConnectionClass; override;
|
||||
Class Function Description : String; override;
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
DBLibLibraryName: string = DBLIBDLL;
|
||||
|
||||
implementation
|
||||
|
||||
uses DBConst, StrUtils, FmtBCD;
|
||||
|
||||
type
|
||||
|
||||
{ TDBLibCursor }
|
||||
|
||||
TDBLibCursor = class(TSQLCursor)
|
||||
protected
|
||||
FQuery: string; //:ParamNames converted to $1,$2,..,$n
|
||||
FCanOpen: boolean; //can return rows?
|
||||
FRowsAffected: integer;
|
||||
FParamReplaceString: string;
|
||||
function ReplaceParams(AParams: TParams; ASQLConnection: TMSSQLConnection): string; //replaces parameters placeholders $1,$2,..$n in FQuery with supplied values in AParams
|
||||
end;
|
||||
|
||||
|
||||
const
|
||||
SBeginTransaction = 'BEGIN TRANSACTION';
|
||||
SAutoCommit = 'AUTOCOMMIT';
|
||||
STextSize = 'TEXTSIZE';
|
||||
|
||||
|
||||
var
|
||||
DBErrorStr, DBMsgStr: string;
|
||||
DBErrorNo, DBMsgNo: integer;
|
||||
|
||||
function DBErrHandler(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PChar):INT; cdecl;
|
||||
begin
|
||||
DBErrorStr:=DBErrorStr+#13+dberrstr;
|
||||
DBErrorNo :=dberr;
|
||||
Result :=INT_CANCEL;
|
||||
end;
|
||||
|
||||
function DBMsgHandler(dbproc: PDBPROCESS; msgno: DBINT; msgstate, severity:INT; msgtext, srvname, procname:PChar; line:DBUSMALLINT):INT; cdecl;
|
||||
begin
|
||||
DBMsgStr:=DBMsgStr+#13+msgtext;
|
||||
DBMsgNo :=msgno;
|
||||
Result :=0;
|
||||
end;
|
||||
|
||||
|
||||
function CheckError(const Ret: RETCODE): RETCODE;
|
||||
var E: EMSSQLDatabaseError;
|
||||
begin
|
||||
if Ret=FAIL then
|
||||
begin
|
||||
E:=EMSSQLDatabaseError.Create(DBErrorStr+#13+DBMsgStr);
|
||||
E.DBErrorCode:=DBErrorNo;
|
||||
DBErrorStr:='';
|
||||
DBMsgStr:='';
|
||||
raise E;
|
||||
end;
|
||||
Result:=Ret;
|
||||
end;
|
||||
|
||||
|
||||
{ TDBLibCursor }
|
||||
|
||||
function TDBLibCursor.ReplaceParams(AParams: TParams; ASQLConnection: TMSSQLConnection): string;
|
||||
var i:integer;
|
||||
ParamNames, ParamValues: array of string;
|
||||
begin
|
||||
if Assigned(AParams) and (AParams.Count > 0) then //taken from mysqlconn, pqconnection
|
||||
begin
|
||||
setlength(ParamNames, AParams.Count);
|
||||
setlength(ParamValues, AParams.Count);
|
||||
for i := 0 to AParams.Count -1 do
|
||||
begin
|
||||
ParamNames[AParams.Count-i-1] := format('%s%d', [FParamReplaceString, AParams[i].Index+1]);
|
||||
ParamValues[AParams.Count-i-1] := ASQLConnection.GetAsSQLText(AParams[i]);
|
||||
//showmessage(ParamNames[AParams.Count-i-1] + '=' + ParamValues[AParams.Count-i-1]);
|
||||
end;
|
||||
Result := stringsreplace(FQuery, ParamNames, ParamValues, [rfReplaceAll]);
|
||||
end
|
||||
else
|
||||
Result := FQuery;
|
||||
end;
|
||||
|
||||
|
||||
{ TSybaseConnection }
|
||||
|
||||
constructor TSybaseConnection.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Ftds := DBTDS_50;
|
||||
end;
|
||||
|
||||
|
||||
{ TMSSQLConnection }
|
||||
|
||||
function TMSSQLConnection.IsSybase: boolean;
|
||||
begin
|
||||
Result := (Ftds=DBTDS_50) or (Ftds=DBTDS_42);
|
||||
end;
|
||||
|
||||
constructor TMSSQLConnection.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FConnOptions := FConnOptions + [sqEscapeRepeat];
|
||||
//FieldNameQuoteChars:=DoubleQuotes; //default
|
||||
Ftds := DBTDS_UNKNOWN;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.GetHandle: pointer;
|
||||
begin
|
||||
Result:=FDBProc;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.GetAsSQLText(Param: TParam): string;
|
||||
function IsBinary(const s: string): boolean;
|
||||
var i: integer;
|
||||
begin
|
||||
for i:=1 to length(s) do if s[i] < #9 then Exit(true);
|
||||
Exit(false);
|
||||
end;
|
||||
function StrToHex(const s: string): string;
|
||||
begin
|
||||
setlength(Result, 2*length(s));
|
||||
BinToHex(PChar(s), PChar(Result), length(s));
|
||||
end;
|
||||
begin
|
||||
if not Param.IsNull then
|
||||
case Param.DataType of
|
||||
ftBoolean:
|
||||
if Param.AsBoolean then
|
||||
Result:='1'
|
||||
else
|
||||
Result:='0';
|
||||
ftString, ftFixedChar, ftMemo:
|
||||
//if IsBinary(Param.AsString) then
|
||||
// Result := '0x' + StrToHex(Param.AsString)
|
||||
//else
|
||||
begin
|
||||
Result := QuotedStr(Param.AsString);
|
||||
if (Ftds >= DBTDS_70) then
|
||||
Result := 'N' + Result
|
||||
else if (Ftds = 0) and (ClientCharset = ccUTF8) then //hack: Microsoft DB-Lib used
|
||||
Result := UTF8Decode(Result);
|
||||
end;
|
||||
ftBlob, ftBytes, ftVarBytes:
|
||||
Result := '0x' + StrToHex(Param.AsString);
|
||||
else
|
||||
Result := inherited GetAsSQLText(Param);
|
||||
end
|
||||
else
|
||||
Result:=inherited GetAsSQLText(Param);
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.DoInternalConnect;
|
||||
const
|
||||
DBVERSION: array[boolean] of BYTE = (DBVER60, DBVERSION_100);
|
||||
IMPLICIT_TRANSACTIONS_OFF: array[boolean] of shortstring = ('SET IMPLICIT_TRANSACTIONS OFF', 'SET CHAINED OFF');
|
||||
ANSI_DEFAULTS_ON: array[boolean] of shortstring = ('SET ANSI_DEFAULTS ON', 'SET QUOTED_IDENTIFIER ON');
|
||||
CURSOR_CLOSE_ON_COMMIT_OFF: array[boolean] of shortstring = ('SET CURSOR_CLOSE_ON_COMMIT OFF', 'SET CLOSE ON ENDTRAN OFF');
|
||||
begin
|
||||
inherited DoInternalConnect;
|
||||
|
||||
InitialiseDBLib(DBLibLibraryName);
|
||||
|
||||
if not DBLibInit then
|
||||
begin
|
||||
dbinit();
|
||||
dberrhandle(@DBErrHandler);
|
||||
dbmsghandle(@DBMsgHandler);
|
||||
DBLibInit:=true;
|
||||
end;
|
||||
|
||||
FDBLogin:=dblogin();
|
||||
if FDBLogin=nil then DatabaseError('dblogin() failed!');
|
||||
|
||||
// DBVERSION_100 is ATM not implemented by FreeTDS 0.91;
|
||||
// set environment variable TDSVER to 5.0: Windows: SET TDSVER=5.0, Unix/Linux: TDSVER=5.0
|
||||
// or in freetds.conf: include "tds version=5.0"
|
||||
dbsetlversion(FDBLogin, DBVERSION[IsSybase]);
|
||||
|
||||
if UserName = '' then
|
||||
dbsetlsecure(FDBLogin)
|
||||
else
|
||||
begin
|
||||
dbsetlname(FDBLogin, PChar(UserName), DBSETUSER);
|
||||
dbsetlname(FDBLogin, PChar(Password), DBSETPWD);
|
||||
end;
|
||||
|
||||
if CharSet = '' then
|
||||
dbsetlcharset(FDBLogin, 'UTF-8')
|
||||
else
|
||||
dbsetlcharset(FDBLogin, PChar(CharSet));
|
||||
|
||||
//dbsetlname(FDBLogin, PChar(TIMEOUT_IGNORE), DBSET_LOGINTIME);
|
||||
dbsetlogintime(10);
|
||||
|
||||
FDBProc := dbopen(FDBLogin, PChar(HostName));
|
||||
if FDBProc=nil then CheckError(FAIL);
|
||||
|
||||
Ftds := dbtds(FDBProc);
|
||||
|
||||
//CheckError( dbsetopt(FDBProc, DBQUOTEDIDENT, '') ); //in FreeTDS executes: "SET QUOTED_IDENTIFIER ON"
|
||||
//CheckError( dbsetopt(FDBProc, DBTEXTSIZE, '2147483647') ); //in FreeTDS: unimplemented, returns FAIL
|
||||
//CheckError( dbsetopt(FDBProc, DBTEXTLIMIT, '2147483647') ); //in FreeTDS: unimplemented, returns FAIL, but required by ntwdblib.dll
|
||||
//CheckError( dbsqlexec(FDBProc) ); //after setting DBTEXTSIZE option
|
||||
//CheckError (dbresults(FDBProc));
|
||||
//while dbresults(FDBProc) = SUCCEED do ;
|
||||
|
||||
// Also SQL Server ODBC driver and Microsoft OLE DB Provider for SQL Server set ANSI_DEFAULTS to ON when connecting
|
||||
//DBExecute(ANSI_DEFAULTS_ON[IsSybase]);
|
||||
DBExecute('SET QUOTED_IDENTIFIER ON');
|
||||
|
||||
if Params.IndexOfName(STextSize) <> -1 then
|
||||
DBExecute('SET TEXTSIZE '+Params.Values[STextSize])
|
||||
else
|
||||
DBExecute('SET TEXTSIZE 16777216');
|
||||
|
||||
if AutoCommit then DBExecute(IMPLICIT_TRANSACTIONS_OFF[IsSybase]); //set connection to autocommit mode - default
|
||||
|
||||
CheckError( dbuse(FDBProc, PChar(DatabaseName)) );
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.DoInternalDisconnect;
|
||||
begin
|
||||
inherited DoInternalDisconnect;
|
||||
|
||||
dbclose(FDBProc);
|
||||
dbfreelogin(FDBLogin);
|
||||
|
||||
ReleaseDBLib;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.AllocateCursorHandle: TSQLCursor;
|
||||
begin
|
||||
Result:=TDBLibCursor.Create;
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
|
||||
begin
|
||||
FreeAndNil(cursor);
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.StrToStatementType(s: string): TStatementType;
|
||||
begin
|
||||
if s = 'EXEC' then
|
||||
Result:=stExecProcedure
|
||||
else
|
||||
Result:=inherited StrToStatementType(s);
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.PrepareStatement(cursor: TSQLCursor;
|
||||
ATransaction: TSQLTransaction; buf: string; AParams: TParams);
|
||||
var
|
||||
ParamBinding : TParamBinding;
|
||||
begin
|
||||
with cursor as TDBLibCursor do
|
||||
begin
|
||||
if assigned(AParams) and (AParams.Count > 0) then
|
||||
FQuery:=AParams.ParseSQL(buf, false, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psSimulated, ParamBinding, FParamReplaceString)
|
||||
else
|
||||
FQuery:=buf;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.UnPrepareStatement(cursor: TSQLCursor);
|
||||
begin
|
||||
if assigned(FDBProc) and (Fstatus <> NO_MORE_ROWS) then
|
||||
dbcanquery(FDBProc);
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.AllocateTransactionHandle: TSQLHandle;
|
||||
begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.GetTransactionHandle(trans: TSQLHandle): pointer;
|
||||
begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.StartDBTransaction(trans: TSQLHandle; AParams: string): boolean;
|
||||
begin
|
||||
Result := not AutoCommit;
|
||||
if Result then
|
||||
DBExecute(SBeginTransaction);
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.Commit(trans: TSQLHandle): boolean;
|
||||
begin
|
||||
DBExecute('COMMIT');
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.Rollback(trans: TSQLHandle): boolean;
|
||||
begin
|
||||
DBExecute('ROLLBACK');
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.CommitRetaining(trans: TSQLHandle);
|
||||
begin
|
||||
if Commit(trans) then
|
||||
DBExecute(SBeginTransaction);
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.RollbackRetaining(trans: TSQLHandle);
|
||||
begin
|
||||
if Rollback(trans) then
|
||||
DBExecute(SBeginTransaction);
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.AutoCommit: boolean;
|
||||
begin
|
||||
Result := StrToBoolDef(Params.Values[SAutoCommit], False);
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.DBExecute(const cmd: string);
|
||||
begin
|
||||
DBErrorStr:='';
|
||||
DBMsgStr :='';
|
||||
CheckError( dbcmd(FDBProc, PChar(cmd)) );
|
||||
CheckError( dbsqlexec(FDBProc) );
|
||||
CheckError( dbresults(FDBProc) );
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.ClientCharset: TClientCharset;
|
||||
begin
|
||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>4)}
|
||||
case CharSet of
|
||||
'' : Result := ccNone;
|
||||
'UTF-8' : Result := ccUTF8;
|
||||
'ISO-8859-1' : Result := ccISO88591;
|
||||
else Result := ccUnknown;
|
||||
end;
|
||||
{$ELSE}
|
||||
if CharSet = '' then
|
||||
Result := ccNone
|
||||
else if CharSet = 'UTF-8' then
|
||||
Result := ccUTF8
|
||||
else if CharSet = 'ISO-8859-1' then
|
||||
Result := ccISO88591
|
||||
else
|
||||
Result := ccUnknown;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
|
||||
var c: TDBLibCursor;
|
||||
cmd: string;
|
||||
res: RETCODE;
|
||||
begin
|
||||
c:=cursor as TDBLibCursor;
|
||||
|
||||
cmd := c.ReplaceParams(AParams, Self);
|
||||
DBExecute(cmd);
|
||||
|
||||
res := SUCCEED;
|
||||
repeat
|
||||
c.FCanOpen := dbcmdrow(FDBProc)=SUCCEED;
|
||||
c.FRowsAffected := dbcount(FDBProc);
|
||||
if assigned(dbiscount) and not dbiscount(FDBProc) then
|
||||
c.FRowsAffected := -1;
|
||||
|
||||
if not c.FCanOpen then //Sybase stored proc.
|
||||
begin
|
||||
repeat until dbnextrow(FDBProc) = NO_MORE_ROWS;
|
||||
res := CheckError( dbresults(FDBProc) );
|
||||
end;
|
||||
until (res = NO_MORE_RESULTS) or c.FCanOpen;
|
||||
|
||||
if res = NO_MORE_RESULTS then
|
||||
Fstatus := NO_MORE_ROWS
|
||||
else
|
||||
Fstatus := MORE_ROWS;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
|
||||
begin
|
||||
if assigned(cursor) then
|
||||
Result := (cursor as TDBLibCursor).FRowsAffected
|
||||
else
|
||||
Result := inherited RowsAffected(cursor);
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.TranslateFldType(SQLDataType: integer): TFieldType;
|
||||
begin
|
||||
case SQLDataType of
|
||||
SQLCHAR: Result:=ftFixedChar;
|
||||
SQLVARCHAR: Result:=ftString;
|
||||
SQLINT1, SQLINT2: Result:=ftSmallInt;
|
||||
SQLINT4, SQLINTN: Result:=ftInteger;
|
||||
SYBINT8: Result:=ftLargeInt;
|
||||
SQLFLT4, SQLFLT8,
|
||||
SQLFLTN: Result:=ftFloat;
|
||||
SQLMONEY4, SQLMONEY,
|
||||
SQLMONEYN: Result:=ftCurrency;
|
||||
SQLDATETIM4, SQLDATETIME,
|
||||
SQLDATETIMN: Result:=ftDateTime;
|
||||
SQLIMAGE: Result:=ftBlob;
|
||||
SQLTEXT: Result:=ftMemo;
|
||||
SQLDECIMAL, SQLNUMERIC: Result:=ftBCD;
|
||||
SQLBIT: Result:=ftBoolean;
|
||||
SQLBINARY: Result:=ftBytes;
|
||||
SQLVARBINARY: Result:=ftVarBytes;
|
||||
SYBUNIQUE: Result:=ftGuid;
|
||||
else
|
||||
DatabaseErrorFmt('Unsupported SQL DataType %d "%s"', [SQLDataType, dbprtype(SQLDataType)]);
|
||||
Result:=ftUnknown;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
|
||||
var i, FieldSize: integer;
|
||||
FieldName: string;
|
||||
FieldType: TFieldType;
|
||||
col: DBCOL;
|
||||
begin
|
||||
col.SizeOfStruct:=sizeof(col);
|
||||
for i:=1 to dbnumcols(FDBProc) do
|
||||
begin
|
||||
if dbtablecolinfo(FDBProc, i, @col) = FAIL then continue;
|
||||
FieldName := col.Name;
|
||||
FieldType := TranslateFldType(col.Typ);
|
||||
case FieldType of
|
||||
ftString, ftFixedChar:
|
||||
begin
|
||||
FieldSize := col.MaxLength;
|
||||
if FieldSize > dsMaxStringSize then FieldSize := dsMaxStringSize;
|
||||
end;
|
||||
ftMemo, ftBlob,
|
||||
ftBytes, ftVarBytes:
|
||||
FieldSize := col.MaxLength;
|
||||
ftBCD:
|
||||
begin
|
||||
FieldSize := col.Scale;
|
||||
if (FieldSize > MaxBCDScale) or (col.Precision-col.Scale > MaxBCDPrecision-MaxBCDScale) then
|
||||
FieldType := ftFmtBCD;
|
||||
end;
|
||||
ftGuid:
|
||||
FieldSize := 38;
|
||||
else
|
||||
FieldSize := 0;
|
||||
if col.Identity and (FieldType = ftInteger) then
|
||||
FieldType := ftAutoInc;
|
||||
end;
|
||||
|
||||
{ // dbcolinfo(), dbcoltype() maps VARCHAR->CHAR, VARBINARY->BINARY:
|
||||
if col.VarLength {true also when column is nullable} then
|
||||
case FieldType of
|
||||
ftFixedChar: FieldType := ftString;
|
||||
ftBytes : FieldType := ftVarBytes;
|
||||
end;
|
||||
}
|
||||
with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, (col.Null=0) and (not col.Identity), i) do
|
||||
begin
|
||||
//if col.Updatable = 0 then Attributes := Attributes + [faReadonly];
|
||||
case FieldType of
|
||||
ftBCD,
|
||||
ftFmtBCD: Precision := col.Precision;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.Fetch(cursor: TSQLCursor): boolean;
|
||||
begin
|
||||
//Compute rows resulting from the COMPUTE clause are not processed
|
||||
repeat
|
||||
Fstatus := dbnextrow(FDBProc);
|
||||
Result := Fstatus=REG_ROW;
|
||||
until Result or (Fstatus = NO_MORE_ROWS);
|
||||
|
||||
if Fstatus = NO_MORE_ROWS then
|
||||
while dbresults(FDBProc) <> NO_MORE_RESULTS do //process remaining results if there are any
|
||||
repeat until dbnextrow(FDBProc) = NO_MORE_ROWS;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef;
|
||||
buffer: pointer; out CreateBlob: boolean): boolean;
|
||||
var i: integer;
|
||||
data, dest: PByte;
|
||||
datalen, destlen: DBINT;
|
||||
srctype, desttype: INT;
|
||||
dbdt: DBDATETIME;
|
||||
dbdr: DBDATEREC;
|
||||
bcdstr: array[0..MaxFmtBCDFractionSize+2] of char;
|
||||
f: double;
|
||||
begin
|
||||
CreateBlob:=false;
|
||||
i:=FieldDef.FieldNo;
|
||||
|
||||
srctype:=dbcoltype(FDBProc,i);
|
||||
data:=dbdata(FDBProc,i);
|
||||
datalen:=dbdatlen(FDBProc,i);
|
||||
Result:=assigned(data) and (datalen<>0);
|
||||
if not Result then
|
||||
Exit;
|
||||
|
||||
dest:=buffer;
|
||||
destlen:=FieldDef.Size;
|
||||
case FieldDef.DataType of
|
||||
ftString, ftFixedChar:
|
||||
desttype:=SQLCHAR;
|
||||
ftBytes:
|
||||
desttype:=SQLBINARY;
|
||||
ftVarBytes:
|
||||
begin
|
||||
PWord(dest)^:=datalen;
|
||||
inc(dest, sizeof(Word));
|
||||
desttype:=SQLBINARY;
|
||||
end;
|
||||
ftSmallInt:
|
||||
begin
|
||||
desttype:=SQLINT2;
|
||||
destlen:=sizeof(DBSMALLINT); //smallint
|
||||
end;
|
||||
ftAutoInc,
|
||||
ftInteger:
|
||||
begin
|
||||
desttype:=SQLINT4;
|
||||
destlen:=sizeof(DBINT); //integer
|
||||
end;
|
||||
ftLargeInt:
|
||||
begin
|
||||
desttype:=SYBINT8;
|
||||
destlen:=sizeof(int64);
|
||||
end;
|
||||
ftCurrency,
|
||||
ftFloat:
|
||||
begin
|
||||
desttype:=SQLFLT8;
|
||||
destlen:=sizeof(DBFLT8); //double
|
||||
end;
|
||||
ftDateTime:
|
||||
begin
|
||||
dest:=@dbdt;
|
||||
desttype:=SQLDATETIME;
|
||||
destlen:=sizeof(dbdt);
|
||||
end;
|
||||
ftBCD:
|
||||
begin
|
||||
dest:=@f;
|
||||
desttype:=SQLFLT8;
|
||||
destlen:=sizeof(DBFLT8); //double
|
||||
end;
|
||||
ftFmtBCD:
|
||||
begin
|
||||
{
|
||||
dbnum.precision:=FieldDef.Precision;
|
||||
dbnum.scale :=FieldDef.Size;
|
||||
dest:=@dbnum;
|
||||
desttype:=SQLNUMERIC;
|
||||
destlen:=sizeof(dbnum);
|
||||
}
|
||||
dest:=@bcdstr[0];
|
||||
desttype:=SQLCHAR;
|
||||
destlen:=sizeof(bcdstr);
|
||||
fillchar(bcdstr, destlen, 0); //required when used ntwdblib.dll
|
||||
end;
|
||||
ftBoolean:
|
||||
begin
|
||||
desttype:=SQLBIT;
|
||||
destlen:=sizeof(WordBool);
|
||||
end;
|
||||
ftGuid:
|
||||
begin
|
||||
desttype:=SQLCHAR;
|
||||
end;
|
||||
ftMemo,
|
||||
ftBlob:
|
||||
begin
|
||||
CreateBlob:=true;
|
||||
Exit;
|
||||
end
|
||||
else
|
||||
//DatabaseErrorFmt('Tried to load field of unsupported field type %s',[FieldTypeNames[FieldDef.DataType]]);
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
dbconvert(FDBProc, srctype, data , datalen, desttype, dest, destlen);
|
||||
|
||||
case FieldDef.DataType of
|
||||
ftString, ftFixedChar:
|
||||
begin
|
||||
PChar(dest + datalen)^ := #0; //strings must be null-terminated
|
||||
if ((Ftds = 0) and (ClientCharset = ccUTF8)) {hack: MS DB-Lib used} or
|
||||
(ClientCharset = ccISO88591) {hack: FreeTDS} then
|
||||
StrPLCopy(PChar(dest), UTF8Encode(PChar(dest)), destlen);
|
||||
end;
|
||||
ftDateTime:
|
||||
begin
|
||||
//detect DBDATEREC version by pre-setting dbdr
|
||||
dbdr.millisecond := -1;
|
||||
if dbdatecrack(FDBProc, @dbdr, @dbdt) = SUCCEED then
|
||||
begin
|
||||
if dbdr.millisecond = -1 then
|
||||
PDateTime(buffer)^ := composedatetime(
|
||||
encodedate(dbdr.oldyear, dbdr.oldmonth, dbdr.oldday),
|
||||
encodetime(dbdr.oldhour, dbdr.oldminute, dbdr.oldsecond, dbdr.oldmillisecond))
|
||||
else
|
||||
PDateTime(buffer)^ := composedatetime(
|
||||
encodedate(dbdr.year, dbdr.month, dbdr.day),
|
||||
encodetime(dbdr.hour, dbdr.minute, dbdr.second, dbdr.millisecond));
|
||||
end;
|
||||
end;
|
||||
ftBCD:
|
||||
PCurrency(buffer)^:=FloatToCurr(f);
|
||||
ftFmtBCD:
|
||||
PBCD(buffer)^:=StrToBCD(bcdstr, FSQLFormatSettings); //PBCD(buffer)^:=dbnumerictobcd(dbnum);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;
|
||||
ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
|
||||
var data: PByte;
|
||||
datalen: DBINT;
|
||||
srctype: INT;
|
||||
begin
|
||||
//see also LoadField
|
||||
srctype:=dbcoltype(FDBProc, FieldDef.FieldNo);
|
||||
data:=dbdata(FDBProc, FieldDef.FieldNo);
|
||||
datalen:=dbdatlen(FDBProc, FieldDef.FieldNo);
|
||||
|
||||
ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, datalen);
|
||||
|
||||
ABlobBuf^.BlobBuffer^.Size :=
|
||||
dbconvert(FDBProc, srctype, data , datalen, srctype, ABlobBuf^.BlobBuffer^.Buffer, datalen);
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.FreeFldBuffers(cursor: TSQLCursor);
|
||||
begin
|
||||
inherited FreeFldBuffers(cursor);
|
||||
end;
|
||||
|
||||
procedure TMSSQLConnection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);
|
||||
const INDEXES_QUERY: array[boolean] of string=(
|
||||
//MS SQL Server; TODO: we can use "execute dbo.sp_helpindex 'TableName'" when Open on Execute will fully work
|
||||
'select i.name, i.indid, c.name as col_name,'+
|
||||
'indexproperty(i.id, i.name, ''IsUnique''),'+
|
||||
'objectproperty(o.id, ''IsPrimaryKey'') '+
|
||||
'from sysindexes i '+
|
||||
' join sysindexkeys k on i.id=k.id and i.indid=k.indid '+
|
||||
' join syscolumns c on k.id=c.id and k.colid=c.colid '+
|
||||
' left join sysobjects o on i.name=o.name and i.id=o.parent_obj '+
|
||||
'where i.id=object_id(''%s'') '+
|
||||
'order by k.indid, k.keyno'
|
||||
,
|
||||
//Sybase; http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.infocenter.help.ase.15.7/title.htm
|
||||
'select i.name, i.indid,' +
|
||||
'index_col(object_name(i.id),i.indid,c.colid) as col_name,' +
|
||||
'(i.status & 2)/2 as IsUnique,' +
|
||||
'(i.status & 2048)/2048 as IsPrimaryKey ' +
|
||||
'from sysindexes i '+
|
||||
' join syscolumns c on c.id=i.id and c.colid<=i.keycnt-case i.indid when 1 then 0 else 1 end ' +
|
||||
'where i.id=object_id(''%s'') '+
|
||||
' and i.indid between 1 and 254 '+ // indid 0 is the table name, 255 is TEXT,IMAGE
|
||||
'order by i.indid, c.colid'
|
||||
);
|
||||
var qry : TSQLQuery;
|
||||
begin
|
||||
//if not assigned(Transaction) then
|
||||
// DatabaseError(SErrConnTransactionnSet);
|
||||
|
||||
qry := TSQLQuery.Create(nil);
|
||||
qry.Transaction := Transaction;
|
||||
qry.Database := Self;
|
||||
with qry do
|
||||
begin
|
||||
ReadOnly := True;
|
||||
SQL.Text := format(INDEXES_QUERY[IsSybase], [TableName]);
|
||||
Open;
|
||||
end;
|
||||
while not qry.Eof do with IndexDefs.AddIndexDef do
|
||||
begin
|
||||
Name := trim(qry.Fields[0].AsString);
|
||||
Fields := trim(qry.Fields[2].AsString);
|
||||
if qry.Fields[3].AsInteger=1 then Options := Options + [ixUnique];
|
||||
if qry.Fields[4].AsInteger=1 then Options := Options + [ixPrimary];
|
||||
qry.Next;
|
||||
while (Name = trim(qry.Fields[0].AsString)) and (not qry.Eof) do
|
||||
begin
|
||||
Fields := Fields + ';' + trim(qry.Fields[2].AsString);
|
||||
qry.Next;
|
||||
end;
|
||||
end;
|
||||
qry.Close;
|
||||
qry.Free;
|
||||
end;
|
||||
|
||||
function TMSSQLConnection.GetSchemaInfoSQL(SchemaType: TSchemaType; SchemaObjectName, SchemaObjectPattern: string): string;
|
||||
const SCHEMA_QUERY='select name as %s from sysobjects where type=''%s'' order by 1';
|
||||
begin
|
||||
case SchemaType of
|
||||
stTables : Result := format(SCHEMA_QUERY, ['table_name','U']);
|
||||
stSysTables : Result := format(SCHEMA_QUERY, ['table_name','S']);
|
||||
stProcedures : Result := format(SCHEMA_QUERY, ['proc_name','P']);
|
||||
stColumns : Result := 'select name as column_name from syscolumns where id=object_id(''' + SchemaObjectName + ''') order by colorder';
|
||||
else
|
||||
DatabaseError(SMetadataUnavailable)
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TMSSQLConnectionDef }
|
||||
|
||||
class function TMSSQLConnectionDef.TypeName: String;
|
||||
begin
|
||||
Result:='MSSQLServer';
|
||||
end;
|
||||
|
||||
class function TMSSQLConnectionDef.ConnectionClass: TSQLConnectionClass;
|
||||
begin
|
||||
Result:=TMSSQLConnection;
|
||||
end;
|
||||
|
||||
class function TMSSQLConnectionDef.Description: String;
|
||||
begin
|
||||
Result:='Connect to MS SQL Server via Microsoft client library or via FreeTDS db-lib';
|
||||
end;
|
||||
|
||||
|
||||
{ TSybaseConnectionDef }
|
||||
|
||||
class function TSybaseConnectionDef.TypeName: String;
|
||||
begin
|
||||
Result:='Sybase';
|
||||
end;
|
||||
|
||||
class function TSybaseConnectionDef.ConnectionClass: TSQLConnectionClass;
|
||||
begin
|
||||
Result:=TSybaseConnection;
|
||||
end;
|
||||
|
||||
class function TSybaseConnectionDef.Description: String;
|
||||
begin
|
||||
Result:='Connect to Sybase SQL Server via FreeTDS db-lib';;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterConnection(TMSSQLConnectionDef);
|
||||
RegisterConnection(TSybaseConnectionDef);
|
||||
|
||||
finalization
|
||||
UnRegisterConnection(TMSSQLConnectionDef);
|
||||
UnRegisterConnection(TSybaseConnectionDef);
|
||||
|
||||
end.
|
||||
|
||||
54
packages/fcl-db/src/sqldb/mssql/readme.txt
Normal file
54
packages/fcl-db/src/sqldb/mssql/readme.txt
Normal file
@ -0,0 +1,54 @@
|
||||
Compiling FreeTDS DB-Lib with MS Visual C++ 2005/2008/2010:
|
||||
===========================================================
|
||||
1. Download sources from www.freetds.org
|
||||
2. Open FreeTDS.dsw from /win32/msvc6 source directory
|
||||
2.1 in libTDS / Header Files edit config.h and comment "HAVE_INTTYPES_H":
|
||||
/* #undef HAVE_INTTYPES_H */
|
||||
(http://www.freetds.org/userguide/osissues.htm#WINDOWS)
|
||||
2.2 In Build / Configuration Manager select "Release"
|
||||
Right-click on project "dblib_dll" and select "Properties". Note: select Configuration Properties first if in Visual C++ 2010.
|
||||
C/C++ / Preprocesor / Preprocessor Definitions add "MSDBLIB" (optionally default TDS version "TDS71")
|
||||
Linker / Input / Additional Dependencies add ".\tds_Release\libTDS.lib"
|
||||
Linker / General / Output File change from ".\dbdll_Release\dblib_dll.dll" to ".\dbdll_Release\dblib.dll"
|
||||
3. Build "dblib_dll"
|
||||
4. The dblib.dll will appear in the .\dbdll_Release\ subdirectory
|
||||
Note: To avoid dependency on msvc*.dll you can set in C/C++ / Code Generation / Runtime Library : "Multi-threaded (/MT)" in all projects
|
||||
|
||||
|
||||
Compiling FreeTDS with iconv support:
|
||||
=====================================
|
||||
(not required when you don't use char/varchar/text datatypes or if you use character set (SBCS) ISO-8859-1 (Latin1) for your char/varchar/text columns)
|
||||
1. Download libiconv developer files and binaries for Windows from http://gnuwin32.sourceforge.net/packages/libiconv.htm
|
||||
Setup program: http://gnuwin32.sourceforge.net/downlinks/libiconv.php
|
||||
- or -
|
||||
Developer files: http://gnuwin32.sourceforge.net/downlinks/libiconv-lib-zip.php (include/iconv.h and lib/libiconv.lib)
|
||||
Binaries: http://gnuwin32.sourceforge.net/downlinks/libiconv-bin-zip.php (bin/libiconv2.dll)
|
||||
and extract them to a directory, e.g. the directory iconv below your root FreeTDS folder
|
||||
2. in libTDS / Header Files edit config.h and uncomment /* #undef HAVE_ICONV */:
|
||||
#define HAVE_ICONV 1
|
||||
3. in Project properties:
|
||||
libTDS: C/C++ / General / Additional Include Directories add path to "include/iconv.h" (e.g. "..\..\iconv\src\libiconv\1.9.2\libiconv-1.9.2\include"
|
||||
dblib_dll: Linker / Input / Additional Dependencies add "lib/libiconv.lib" (e.g. "..\..\iconv\lib\libiconv.lib"
|
||||
4. Follow regular compilation instructions above
|
||||
5. Distribute libiconv2.dll with your dblib.dll
|
||||
|
||||
|
||||
Using in Lazarus:
|
||||
=================
|
||||
1. Put on the form TSQLConnector and set property ConnectorType=MSSQLServer
|
||||
2. Put into uses clause mssqlconn unit
|
||||
|
||||
|
||||
Known problems:
|
||||
===============
|
||||
- CHAR/VARCHAR data truncated to column length when encoding to UTF-8 (use NCHAR/NVARCHAR instead or CAST char/varchar to nchar/nvarchar)
|
||||
- Multiple result sets (for example when SP returns more than 1 result set only 1st is processed)
|
||||
- DB-Library error 10038 "Results Pending" - set TSQLQuery.PacketRecords=-1 to fetch all pendings rows
|
||||
- BLOB data (IMAGE/TEXT columns) larger than 16MB are truncated to 16MB - (set TMSSQLConnection.Params: 'TEXTSIZE=2147483647' or execute 'SET TEXTSIZE 2147483647')
|
||||
(create temporary stored procedures for prepared statements)
|
||||
|
||||
|
||||
Manuals for DB-Library API:
|
||||
===========================
|
||||
http://msdn.microsoft.com/en-us/library/aa936988(v=sql.80).aspx
|
||||
http://manuals.sybase.com/onlinebooks/group-cnarc/cng1110e/dblib/
|
||||
Loading…
Reference in New Issue
Block a user