123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628 |
- {
- 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 tds.h:
- SYBNTEXT=$63;
- SYBINT8=$7F;
- SYBUNIQUE=$24;
- SYBVARIANT=$62;
- //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
- // Error codes:
- SYBEFCON = 20002; // SQL Server connection failed
- 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;
- // 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 AnsiChar;
- 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 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}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;
- 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: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;
- 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: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;
- DBLibLoadedLibrary: string = '';
- {$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;
- 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(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: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.
|