sybase32.pas

sybase大全

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.