www.pudn.com > sybase_dblib4.zip > sybase32.pas
unit sybase32;
interface
uses sysutils,winprocs,dialogs;
Const Succeed = 1;
Fail = 0;
More_Rows = -1;
No_More_Rows = -2;
No_More_Results = 2;
dbNoErr = -1;
{Options to be be set with dbsetopt() }
DBPARSEONLY = 0;
DBESTIMATE = 1;
DBSHOWPLAN = 2;
DBNOEXEC = 3;
DBARITHIGNORE = 4;
DBNOCOUNT = 5;
DBARITHABORT = 6;
DBTEXTLIMIT = 7;
DBBROWSE = 8;
DBOFFSET = 9;
DBSTAT = 10;
DBERRLVL = 11;
DBCONFIRM = 12;
DBSTORPROCID = 13;
DBBUFFER = 14;
DBNOAUTOFREE = 15;
DBROWCOUNT = 16;
DBTEXTSIZE = 17;
DBNATLANG = 18;
DBDATEFORMAT = 19;
DBPRPAD = 20;
DBPRCOLSEP = 21;
DBPRLINELEN = 22;
DBPRLINESEP = 23;
DBLFCONVERT = 24;
DBDATEFIRST = 25;
DBCHAINXACTS = 26;
DBFIPSFLAG = 27;
DBISOLATION = 28;
DBAUTH = 29;
DBIDENTITY = 30;
DBNOIDCOL = 31;
{ Bind methods }
NOBIND = -1;
TINYBIND = 1;
SMALLBIND = 2;
INTBIND = 3;
CHARBIND = 4;
TEXTBIND = 5;
BINARYBIND = 6;
ARRAYBIND = 7;
BITBIND = 8;
DATETIMEBIND = 9;
MONEYBIND = 10;
FLT8BIND = 11;
STRINGBIND = 12;
NTBSTRINGBIND = 13;
VARYCHARBIND = 14;
VARYBINBIND = 15;
SMALLDATETIMEBIND = 16;
SMALLMONEYBIND = 17;
REALBIND = 18;
NUMERICBIND = 19;
DECIMALBIND = 20;
SENSITIVITYBIND = 21;
BOUNDARYBIND = 22;
{RPC Status}
DBRPCNORETURN = 0;
DBRPCRETURN = 1;
DB__NODEFAULT = 2;
{RPC Options}
DBRPCRECOMPILE = 1;
DBNOTIFYALL = 2;
DBNOTIFYNEXT = 4;
{This constant is used in dbregparam() to define
a parameter that has no default data value.}
DBNODEFAULT = -2;
{Data Types}
SYBVOID = 32;
SYBBINARY = 45;
SYBBIT = 50;
SYBCHAR = 47;
SYBDATETIME4 = 58;
SYBDATETIME = 61;
SYBDATETIMN = 111;
SYBDECIMAL = 106;
SYBFLT8 = 62;
SYBFLTN = 109;
SYBREAL = 59;
SYBIMAGE = 34;
SYBINT1 = 48;
SYBINT2 = 52;
SYBINT4 = 56;
SYBINTN = 38;
SYBLONGBINARY = 225;
SYBLONGCHAR = 175;
SYBMONEY4 = 122;
SYBMONEY = 60;
SYBMONEYN = 110;
SYBNUMERIC = 108;
SYBTEXT = 35;
SYBVARBINARY = 37;
SYBVARCHAR = 39;
SYBSENSITIVITY = 103;
SYBBOUNDARY = 104;
type
Pcs_datafmt = ^Tcs_datafmt;
Tcs_datafmt = record
name :pchar;
namelen :integer;
datatype :integer;
format :integer;
maxlength :integer;
scale :integer;
precision :integer;
status :integer;
count :integer;
usertype :integer;
locale :pointer;
end;
type
Pcs_clientmsg = ^Tcs_clientmsg;
Tcs_clientmsg = record
severity :integer;
msgnumber :integer;
msgstring :pchar;
msgstringlen :integer;
osnumber :integer;
osstring :pchar;
osstringlen :integer;
status :integer;
sqlstate :byte;
sqlstatelen :integer;
end;
{type col_string = array[0..sizeof(string)] of char;}
type col_string = array[0..2048000] of char;
var col_value : col_string;
function dbmorecmds(dbProc:integer):longint;stdcall;external 'libsybdb.dll';
function dbcurcmd(dbProc:integer):longint;stdcall;external 'libsybdb.dll';
function dbvalue(dbProc, column : integer):Pchar;far;
function dbretvalue(dbProc, column : integer):Pchar;far;
function dbsetlogintime(seconds:integer):integer; stdcall; external 'libsybdb.dll';
function dbsettime(seconds:integer):integer; stdcall; external 'libsybdb.dll';
function dblogin:integer;stdcall;external 'libsybdb.dll';
function dbinit:pointer;stdcall;external 'libsybdb.dll';
procedure dbexit;stdcall;external 'libsybdb.dll';
procedure dbloginfree(login:integer);stdcall;external 'libsybdb.dll';
procedure dbwinexit;stdcall;external 'libsybdb.dll';
function dbopen(login:integer;s:pchar):integer;stdcall;external 'libsybdb.dll';
function dbsetlname(login:integer;s:pointer;x:word):integer;stdcall;external 'libsybdb.dll';
function dbuse(dbProc:integer;dbname:pointer):integer;stdcall;external 'libsybdb.dll';
function dbsetopt(dbProc,Option:integer;Param:pchar;int_parm:integer):integer;stdcall;external 'libsybdb.dll';
function dbstrcpy(dbProc,start,numbytes:integer;dest:pchar):integer;stdcall;external 'libsybdb.dll';
function dbgetrow(dbProc:integer;row:longint):integer;stdcall;external 'libsybdb.dll';
function dbclrbuf(dbProc:integer;rows:longint):integer;stdcall;external 'libsybdb.dll';
function dbfirstrow(dbProc:integer):longint;stdcall;external 'libsybdb.dll';
function dblastrow(dbProc:integer):longint;stdcall;external 'libsybdb.dll';
function dbcurrow(dbProc:integer):longint;stdcall;external 'libsybdb.dll';
function dbcmd(dbProc:integer;command:pointer):integer;stdcall;external 'libsybdb.dll';
function dbcmdrow(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dbfcmd(dbProc:integer;command:pointer;arg:longint):integer;stdcall;external 'libsybdb.dll';
function dbsqlexec(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dbresults(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dbrows(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dbnextrow(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dberrhandle(hErr:pointer):pointer;stdcall;external 'libsybdb.dll';
function dbmsghandle(hMsg:pointer):pointer;stdcall;external 'libsybdb.dll';
function dbbind(dbProc,col,vartype:integer;varlen:longint;varaddr:pointer):integer;stdcall;external 'libsybdb.dll';
procedure dbfreelogin(Login:integer);stdcall;external 'libsybdb.dll';
procedure dbclose(dbProc:integer);stdcall;external 'libsybdb.dll';
procedure dbprhead(dbProc:integer);stdcall;external 'libsybdb.dll';
function dbdead(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dbspid(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dbprrow(dbProc:integer):integer;stdcall;external 'libsybdb.dll';
function dbdatlen(dbproc, column : integer) : integer;stdcall; external 'libsybdb.dll';
function dbdata(dbproc, column : integer):pointer;stdcall;external 'libsybdb.dll';
function dbcolname(dbproc, column : integer):Pchar; stdcall;external 'libsybdb.dll';
function dbcolsource(dbproc, column : integer):Pchar; stdcall;external 'libsybdb.dll';
function dbname(dbproc:integer):Pchar; stdcall;external 'libsybdb.dll';
function dbversion :Pchar; stdcall;external 'libsybdb.dll';
function dbgetcharset(dbproc:integer) :Pchar; stdcall;external 'libsybdb.dll';
function dbservcharset(dbproc:integer) :Pchar; stdcall;external 'libsybdb.dll';
function dbsetdefcharset(char_set:pchar):integer;stdcall;external 'libsybdb.dll';
function dbgetnatlang(dbproc:integer) :Pchar; stdcall;external 'libsybdb.dll';
function dbqual(dbproc,tabnum:integer;tabname:pchar):Pchar; stdcall;external 'libsybdb.dll';
function dbcoltype(dbproc, column : integer):integer; stdcall;external 'libsybdb.dll';
function dbcolutype(dbproc, column : integer):integer; stdcall;external 'libsybdb.dll';
function dbprtype(token : integer):pchar; stdcall;external 'libsybdb.dll';
function dbnumcols(dbproc : integer):integer;stdcall;external 'libsybdb.dll';
function dbtxptr(dbproc, column : integer):pchar; stdcall;external 'libsybdb.dll';
function dbtxtimestamp(dbproc, column : integer):Pchar; stdcall;external 'libsybdb.dll';
procedure dbrecftos(filename:pchar);stdcall;external 'libsybdb.dll';
function dbwritetext(dbproc :integer;
objname :pchar;
textptr :pchar;
textptrlen :integer;
timestamp :pchar;
log :boolean;
size :integer;
text :pchar):integer; stdcall;external 'libsybdb.dll';
function dbconvert(dbproc, srctype :integer;
src : pointer; srclen :longint;
desttype :integer; dest : pointer;
destlen : longint) : integer; stdcall;external 'libsybdb.dll';
function dbcollen(dbproc, column : integer):longint; stdcall;external 'libsybdb.dll';
function dbcount(dbproc : integer) : longint; stdcall;external 'libsybdb.dll';
function dbcanquery(dbproc : integer) : integer; stdcall;external 'libsybdb.dll';
function dbcancel(dbproc : integer) : integer; stdcall;external 'libsybdb.dll';
procedure dbsetbusy(dbproc:integer;busyfunc:pointer);stdcall;external 'libsybdb.dll';
procedure dbsetidle(dbproc:integer;idlefunc:pointer);stdcall;external 'libsybdb.dll';
{********************* Stored Procedures /RPC ******************************}
function dbrpcinit(dbproc:integer;
rpcname:pchar;
option:integer) : integer; stdcall;external 'libsybdb.dll';
function dbrpcparam(dbproc:integer;
paramname:pchar;
status:integer;
typ:integer;
maxlen:integer;
datalen:integer;
value:pointer) : integer; stdcall;external 'libsybdb.dll';
function dbrpcsend(dbproc:integer) : integer; stdcall;external 'libsybdb.dll';
function dbsqlok(dbproc:integer) : integer; stdcall;external 'libsybdb.dll';
function dbnumrets(dbproc:integer) : integer; stdcall;external 'libsybdb.dll';
function dbretdata(dbproc:integer; retnum : integer) :pointer; stdcall;external 'libsybdb.dll';
function dbretlen(dbproc:integer; retnum : integer) : integer; stdcall;external 'libsybdb.dll';
function dbretname(dbproc:integer; retnum : integer) : pchar; stdcall;external 'libsybdb.dll';
function dbretstatus(dbproc:integer): integer; stdcall;external 'libsybdb.dll';
function dbrettype(dbproc:integer; retnum:integer) : integer; stdcall;external 'libsybdb.dll';
{********************* BCP ******************************}
function bcp_batch(dbproc:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_bind(dbproc:integer;
varaddr:pchar;
preficlen:integer;
varlen:longint;
terminator:pchar;
termlen:integer;
typ:integer;
table_column:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_colfmt(dbProc:integer;
host_column:integer;
host_type:integer;
host_prefixlen:integer;
host_collen:integer;
host_term:PChar;
host_termlen:integer;
table_colnum:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_collen(dbproc:integer;
table_column:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_colptr(dbproc:integer;
colptr:pchar;
table_column:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_columns(dbProc:integer;
host_colcount:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_control(dbProc:integer;
field:integer;
value:longint):integer; stdcall;external 'libsybdb.dll';
function bcp_done(dbproc:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_exec(dbProc:integer;
rows_copied:pointer):integer; stdcall;external 'libsybdb.dll';
function bcp_getl(dbproc:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_init(dbProc:integer;
table:PChar;
host:PChar;
err:PChar;
direction:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_readfmt(dbProc:integer;
sFormatFile:PChar):integer; stdcall;external 'libsybdb.dll';
function bcp_sendrow(dbproc:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_setl(LoginRec:integer;
enable:integer):integer; stdcall;external 'libsybdb.dll';
function bcp_writefmt(dbProc:integer;
sFormatFile:PChar):integer; stdcall;external 'libsybdb.dll';
Function dbsetlbool(login:integer;
s:integer;
x:word):integer; stdcall;external 'libsybdb.dll';
{********************* BCP ******************************}
Function Errors(dbproc:integer;
severity:integer;
dberr:integer;
oserr:integer;
dberrs:pchar;
oserrs:pchar):integer;stdcall;export;
Function syb_messages(dbproc:integer;
msgno:longint;
msgstate:integer;
severity:integer;
msgtext:pchar;
srvname:pchar;
procname:pchar;
line:smallint):integer; stdcall;export;
var buffer :Pcs_clientmsg;
s :pchar;
implementation
Function dbvalue(dbproc, column : integer) : Pchar;
var col_ptr : Pchar;
col_length : integer;
col_type : integer;
new_length : integer;
Quote_Pos : Pchar;
FirstChar : Char;
s:string;
r:real;
err:integer;
Begin
{ Fillchar(col_value,sizeof(col_value),0);}
col_ptr := dbdata(dbproc, column);
col_length := dbdatlen(dbProc, column);
col_type := dbcoltype(dbProc, column);
if (col_length = 0) or (col_ptr = nil) then Begin
dbValue := nil;
exit;
End;
IF (col_type <> 47) then
Begin
IF (col_type <> 35) then
new_length := dbconvert(dbproc, col_type, col_ptr, col_length,
47, @col_value, 255)
else
new_length := dbconvert(dbproc, col_type, col_ptr, col_length,
35, @col_value,-1);
col_value[new_length] := #0;
End
Else
Begin
{ if col_length > 255 then
col_length := 255;}
strlcopy(@Col_value,col_ptr,col_length);
End;
dbValue := @col_value;
end;
Function dbretvalue(dbproc, column : integer) : Pchar;
var col_ptr : Pchar;
col_length : integer;
col_type : integer;
new_length : integer;
Quote_Pos : Pchar;
FirstChar : Char;
s:string;
r:real;
err:integer;
Begin
{ Fillchar(col_value,sizeof(col_value),0);}
col_ptr := dbretdata(dbproc, column);
col_length := dbretlen(dbProc, column);
col_type := dbrettype(dbProc, column);
if (col_length = 0) or (col_ptr = nil) then Begin
dbRetValue := nil;
exit;
End;
IF (col_type <> 47) then
Begin
IF (col_type <> 35) then
new_length := dbconvert(dbproc, col_type, col_ptr, col_length,
47, @col_value, 255)
else
new_length := dbconvert(dbproc, col_type, col_ptr, col_length,
35, @col_value,-1);
col_value[new_length] := #0;
End
Else
Begin
{ if col_length > 255 then
col_length := 255;}
strlcopy(@Col_value,col_ptr,col_length);
End;
dbRetValue := @col_value;
end;
Function Errors(dbproc:integer;
severity:integer;
dberr:integer;
oserr:integer;
dberrs:pchar;
oserrs:pchar):integer;export;
Begin
if (dbproc = 0) or (dbdead(dbProc)=0) then
begin
end
else
Begin
If Severity > 3 then
Messagebox(GetActiveWindow,dberrs,'DB-Library error',mb_ok+mb_iconexclamation{+mb_systemmodal});
if oserr <> DbNoErr then begin
MessageBox(GetActiveWindow,oserrs,'Operating System error',mb_ok+mb_iconexclamation{+mb_systemmodal});
end;
end;
End;
Function syb_messages(dbproc:integer;
msgno:longint;
msgstate:integer;
severity:integer;
msgtext:pchar;
srvname:pchar;
procname:pchar;
line:smallint):integer;export;
var msg :array[0..255] of char;
msg1 :string[255];
Begin
msg1:=strpas(msgtext) + char(13) + char(10) + 'LINE : ' + inttostr(line);
strpcopy(msg,msg1);
if ((severity > 3)
or (msgno = 0)
or (msgno = 6289)
or (msgno = 6201)
or (msgno = 6203)
or (msgno = 6215)
or (msgno = 6217)
or (msgno = 6219)
or (msgno = 6225)
or (msgno = 6223)
or (msgno = 6227)
or (msgno = 6282)
or (msgno = 6286)
or (msgno = 6272)
or (msgno = 6273)
or (msgno = 6278)
or (msgno = 6276)
or (msgno = 3614)
or (msgno = 3615)
or (msgno = 3613)
or (msgno = 3612)
or ((msgno >=7309) and (msgno<=7326))
or ((msgno >=7337) and (msgno<=7341))
or ((msgno >=7349) and (msgno<=7362)))
and (msgno <> 2409) then
MessageBox(GetActiveWindow,msg,pchar('SQL Server Message - ' + inttostr(msgno)),mb_ok+mb_iconexclamation);
End;
Function CT_Errors(context :integer;
connection :pointer;
clientmsg :Pcs_clientmsg):integer;stdcall;export;
var s :pchar;
begin
// buffer:=Pcs_clientmsg(clientmsg);
s:=clientmsg.msgstring;
MessageBox(GetActiveWindow,s,pchar('SQL Server Message'),mb_ok+mb_iconexclamation);
// MessageBox(GetActiveWindow,'test1',pchar('SQL Server Message'),mb_ok+mb_iconexclamation);
end;
begin
new(buffer);
end.