Repository URL to install this package:
|
Version:
3.0.0 ▾
|
{
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}
{$IFDEF DARWIN}
'libsybdb.dylib'
{$ELSE}
'libsybdb.so'
{$ENDIF}
{$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 , sybdb.h for FreeTDS
DBSETHOST=1;
DBSETUSER=2;
DBSETPWD =3;
DBSETAPP ={$IFDEF freetds}5{$ELSE}4{$ENDIF};
{$IFDEF freetds}
DBSETHID = 4;
DBSETBCP = 6;
DBSETNATLANG= 7;
DBSETNOSHORT= 8;
DBSETHIER = 9;
DBSETCHARSET= 10;
DBSETPACKET = 11;
DBSETENCRYPT= 12;
DBSETLABELED= 13;
DBSETDBNAME = 14;
{$ELSE}
DBSETID = 5;
DBSETLANG = 6;
DBSETSECURE = 7;
DBSET_LOGINTIME=10;
DBSETFALLBACK=12;
{$ENDIF}
//These two are defined by Microsoft for dbsetlversion():
DBVER42={$IFDEF freetds}DBVERSION_42{$ELSE}8{$ENDIF};
DBVER60={$IFDEF freetds}DBVERSION_71{$ELSE}9{$ENDIF};
//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 proto.h:
SYBNTEXT=$63;
// MS only types:
SYBINT8 =$7F;
SYBUNIQUE =$24;
SYBVARIANT=$62;
SYBMSUDT =$F0;
SYBMSXML =$F1;
SYBMSDATE =$28;
SYBMSTIME =$29;
SYBMSDATETIME2=$2A;
SYBMSDATETIMEOFFSET=$2B;
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
// Error codes:
SYBEFCON = 20002; // SQL Server connection failed
SYBESMSG = 20018; // General SQL Server error: Check messages from the SQL Server.
type
PLOGINREC=Pointer;
PDBPROCESS=Pointer;
RETCODE=integer;
STATUS=integer;
INT=longint;
SHORT=smallint;
BOOL=longbool;
ULONG=longword;
// DB-Library datatypes
DBBOOL=byte; // unsigned char
DBCHAR=shortint;
DBBIT=byte;
DBTINYINT=byte;
DBSMALLINT=smallint; // 16-bit int (short)
DBUSMALLINT=word; // 16-bit unsigned int (unsigned short)
DBINT=longint; // 32-bit int (int)
DBFLT8=double; // 64-bit real (double)
DBBINARY=byte;
{$PACKRECORDS C}
DBDATETIME=packed record
dtdays: DBINT;
dttime: ULONG;
end;
PDBDATETIME=^DBDATETIME;
DBDATETIMEALL=record
time: qword; // time, 7 digit precision (64-bit unsigned)
date: longint; // date, 0 = 1900-01-01 (32-bit int)
offset: smallint; // time offset (16-bit int)
info: word; // unsigned short time_prec:3;
// unsigned short _res:10;
// unsigned short has_time:1;
// unsigned short has_date:1;
// unsigned short has_offset:1;
end;
PDBDATETIMEALL=^DBDATETIMEALL;
// 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;
DBMONEY=record
mnyhigh: DBINT;
mnylow: ULONG;
end;
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 AnsiChar;
end;
DBERRHANDLE_PROC=function(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PAnsiChar):INT; cdecl;
DBMSGHANDLE_PROC=function(dbproc: PDBPROCESS; msgno: DBINT; msgstate, severity:INT; msgtext, srvname, procname:PAnsiChar; line:DBUSMALLINT):INT; cdecl;
{$IFDEF ntwdblib}
{$PACKRECORDS 2}
{$ENDIF}
DBCOL=record
SizeOfStruct: DBINT;
Name: array[0..MAXCOLNAMELEN] of AnsiChar;
ActualName: array[0..MAXCOLNAMELEN] of AnsiChar;
TableName: array[0..MAXTABLENAME] of AnsiChar;
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}PAnsiChar{$ENDIF}; cdecl; external DBLIBDLL;
function dblogin():PLOGINREC; cdecl; external DBLIBDLL;
function dbsetlname(login:PLOGINREC; value:PAnsiChar; 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:PAnsiChar {$IFDEF freetds};int_param:INT{$ENDIF}):RETCODE; cdecl; external DBLIBDLL;
function dbuse(dbproc:PDBPROCESS; dbname:PAnsiChar):RETCODE; cdecl; external DBLIBDLL;
function dbcmd(dbproc:PDBPROCESS; cmdstring:PAnsiChar):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):PAnsiChar; 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):PAnsiChar; cdecl; external DBLIBDLL;
function dbdatlen(dbproc:PDBPROCESS; column:INT):DBINT; cdecl; external DBLIBDLL;
function dbdata(dbproc:PDBPROCESS; column:INT):PByte; cdecl; external DBLIBDLL;
function dbwillconvert(srctype, desttype: INT):{$IFDEF freetds}DBBOOL{$ELSE}BOOL{$ENDIF}; 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;
function dbhasretstat(dbproc:PDBPROCESS):DBBOOL; cdecl; external DBLIBDLL;
function dbretstatus(dbproc:PDBPROCESS):DBINT; 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:PAnsiChar):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:PAnsiChar; 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):PAnsiChar; cdecl; external DBLIBDLL;
procedure dbclose(dbproc:PDBPROCESS); cdecl; external DBLIBDLL;
{$ENDIF}
{$ELSE}
var
dbinit: function():{$IFDEF freetds}RETCODE{$ELSE}PAnsiChar{$ENDIF}; cdecl;
dblogin: function():PLOGINREC; cdecl;
dbsetlname: function(login:PLOGINREC; value:PAnsiChar; 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:PAnsiChar {$IFDEF freetds};int_param:INT{$ENDIF}):RETCODE; cdecl;
dbuse: function(dbproc:PDBPROCESS; dbname:PAnsiChar):RETCODE; cdecl;
dbcmd: function(dbproc:PDBPROCESS; cmdstring:PAnsiChar):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):PAnsiChar; 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):PAnsiChar; cdecl;
dbdatlen: function(dbproc:PDBPROCESS; column:INT):DBINT; cdecl;
dbdata: function(dbproc:PDBPROCESS; column:INT):PByte; cdecl;
dbwillconvert: function(srctype, desttype: INT):{$IFDEF freetds}DBBOOL{$ELSE}BOOL{$ENDIF}; 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;
dbhasretstat: function(dbproc:PDBPROCESS):DBBOOL; cdecl;
dbretstatus: function(dbproc:PDBPROCESS):DBINT; cdecl;
dbexit: procedure(); cdecl;
dbfreelogin: procedure(login:PLOGINREC); cdecl;
{$IFDEF ntwdblib}
dbopen: function(login:PLOGINREC; servername:PAnsiChar):PDBPROCESS; cdecl;
dbclose: function(dbproc:PDBPROCESS):RETCODE; cdecl;
dbwinexit: procedure; cdecl;
{$ENDIF}
{$IFDEF freetds}
tdsdbopen: function(login:PLOGINREC; servername:PAnsiChar; 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):PAnsiChar; cdecl;
dbclose: procedure(dbproc:PDBPROCESS); cdecl;
{$ENDIF}
DefaultDBLibLibraryName: string = DBLIBDLL;
DBLibLoadedLibrary: string = '';
{$ENDIF}
{$IFDEF ntwdblib}
function tdsdbopen(login:PLOGINREC; servername:PAnsiChar; 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():PAnsiChar;
{$ENDIF}
{$IFDEF freetds}
function dbopen(login:PLOGINREC; servername:PAnsiChar):PDBPROCESS;
procedure dbwinexit;
{$ENDIF}
function dbsetlcharset(login:PLOGINREC; charset:PAnsiChar):RETCODE;
function dbsetlsecure(login:PLOGINREC):RETCODE;
function dbdatetimeallcrack(dta: PDBDATETIMEALL): TDateTime;
function dbmoneytocurr(pdbmoney: PQWord): Currency;
function InitialiseDBLib(const LibraryName : ansistring): integer;
procedure ReleaseDBLib;
implementation
{$IFDEF LOAD_DYNAMICALLY}
uses SysUtils, Dynlibs;
var DBLibLibraryHandle: TLibHandle;
RefCount: integer;
function InitialiseDBLib(const LibraryName : ansistring): integer;
var libname : string;
begin
inc(RefCount);
Result:=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.'+LineEnding+'%s',
[libname, SysErrorMessage(GetLastOSError)]);
end;
DBLibLoadedLibrary := libname;
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(dbwillconvert) := GetProcedureAddress(DBLibLibraryHandle,'dbwillconvert');
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(dbhasretstat) := GetProcedureAddress(DBLibLibraryHandle,'dbhasretstat');
pointer(dbretstatus) := GetProcedureAddress(DBLibLibraryHandle,'dbretstatus');
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
begin
DBLibLibraryHandle := NilHandle;
DBLibLoadedLibrary := '';
end
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:PAnsiChar):PDBPROCESS;
begin
Result:=tdsdbopen(login, servername, 1{1=MSDBLIB or 0=SYBDBLIB});
end;
function dbsetlcharset(login:PLOGINREC; charset:PAnsiChar):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:PAnsiChar; 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:PAnsiChar):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():PAnsiChar;
begin
Result:='DB Library version 8.00';
end;
{$ENDIF}
function dbdatetimeallcrack(dta: PDBDATETIMEALL): TDateTime;
begin
if dta^.info and $4000 = 0 then
Result := 0
else
Result := dta^.date + 2;
Result := ComposeDateTime(Result, dta^.time/MSecsPerDay/10000 + dta^.offset/MinsPerDay);
end;
function dbmoneytocurr(pdbmoney: PQWord): Currency;
begin
{$IFDEF ENDIAN_LITTLE}
PQWord(@Result)^ := pdbmoney^ shr 32 or pdbmoney^ shl 32;
{$ELSE}
move(pdbmoney^, Result, sizeof(Currency));
{$ENDIF}
end;
{
//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.