fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2007-11-15 20:44 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
+ contrib/firebird
   + contrib/firebird/Makefile
   + contrib/firebird/make_b32.bat
   + contrib/firebird/make_vc.bat
   + contrib/firebird/common.mak
   + contrib/firebird/tfirebird.prg
   + contrib/firebird/firebird.c
   + contrib/firebird/readme.txt
   + contrib/firebird/test
   + contrib/firebird/test/Makefile
   + contrib/firebird/test/bld_b32.bat
   + contrib/firebird/test/simple.prg
   + contrib/firebird/test/test.prg
   + contrib/firebird/test/stress.prg
   + contrib/firebird/test/testapi.c
     + Added firebird library, with some warnings and other 
       minor things fixed, and Harbour std non-GNU make / build 
       files added.
     ; TOFIX: There is still a potentially dangerous 
              warning to be fixed in FBGETBLOB().

   * contrib/hbzlib/make_b32.bat
   * contrib/hbzlib/make_vc.bat
     ! Fixed to not override C_USR set by user.

   + contrib/mysql/test
   + contrib/mysql/test/test.prg
   - contrib/mysql/test.prg
     * Moved test file to test dir.
This commit is contained in:
Viktor Szakats
2007-11-15 19:48:32 +00:00
parent e6124ce8bf
commit 043cd01674
17 changed files with 3009 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
harbour/ChangeLog
View File

@@ -8,6 +8,37 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-11-15 20:44 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
+ contrib/firebird
+ contrib/firebird/Makefile
+ contrib/firebird/make_b32.bat
+ contrib/firebird/make_vc.bat
+ contrib/firebird/common.mak
+ contrib/firebird/tfirebird.prg
+ contrib/firebird/firebird.c
+ contrib/firebird/readme.txt
+ contrib/firebird/test
+ contrib/firebird/test/Makefile
+ contrib/firebird/test/bld_b32.bat
+ contrib/firebird/test/simple.prg
+ contrib/firebird/test/test.prg
+ contrib/firebird/test/stress.prg
+ contrib/firebird/test/testapi.c
+ Added firebird library, with some warnings and other
minor things fixed, and Harbour std non-GNU make / build
files added.
; TOFIX: There is still a potentially dangerous
warning to be fixed in FBGETBLOB().
* contrib/hbzlib/make_b32.bat
* contrib/hbzlib/make_vc.bat
! Fixed to not override C_USR set by user.
+ contrib/mysql/test
+ contrib/mysql/test/test.prg
- contrib/mysql/test.prg
* Moved test file to test dir.
2007-11-15 00:20 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* contrib/xhb/make_b32.bat
* contrib/xhb/make_vc.bat

17
harbour/contrib/firebird/Makefile Normal file
View File

@@ -0,0 +1,17 @@
#
# $Id: Makefile 4853 2001-12-25 16:51:58Z lculik $
#
ROOT = ../../
CFLAGS += -I/opt/firebird/include
C_SOURCES=\
firebird.c \
PRG_SOURCES=\
tfirebird.prg \
LIBNAME=firebird
include $(TOP)$(ROOT)config/lib.cf

18
harbour/contrib/firebird/common.mak Normal file
View File

@@ -0,0 +1,18 @@
#
# $Id: common.mak 7935 2007-11-10 11:31:17Z vszakats $
#
LIBNAME = firebird
LIB_PATH = $(LIB_DIR)\$(LIBNAME)$(LIBEXT)
#
# LIB rules
#
LIB_OBJS = \
$(OBJ_DIR)\firebird$(OBJEXT) \
$(OBJ_DIR)\tfirebird$(OBJEXT) \
all: \
$(LIB_PATH) \

737
harbour/contrib/firebird/firebird.c Normal file
View File

@@ -0,0 +1,737 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
/*
* xHarbour Project source code:
* Firebird RDBMS low level (client api) interface code.
*
* Copyright 2003 Rodrigo Moreno rodrigo_moreno@yahoo.com
* www - http://www.xharbour.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* 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. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
* See doc/license.txt for licensing terms.
*
*/
#define _CLIPDEFS_H
#if defined(HB_OS_WIN_32_USED)
#include <windows.h>
#endif
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <time.h>
#include "extend.api"
#include "item.api"
#include "hbapiitm.h"
#include "ibase.h"
#define DIALECT 1
#define MAX_FIELDS 5
#define MAX_LEN 256
#define MAX_BUFFER 1024
#define ERREXIT(status) { _retnl(isc_sqlcode(status)); return; }
#ifndef ISC_INT64_FORMAT
#if (defined(_MSC_VER) && defined(WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__))
#define ISC_INT64_FORMAT "I64"
#else
#define ISC_INT64_FORMAT "ll"
#endif
#endif
HB_FUNC(FBCREATEDB)
{
isc_db_handle newdb = NULL;
isc_tr_handle trans = NULL;
long status[20];
char create_db[MAX_BUFFER];
char *db_name;
char *user;
char *pass;
char *charset;
int page;
int dialect;
if (hb_pcount() != 6)
{
_retni(0);
return;
}
db_name = hb_parcx(1);
user = hb_parcx(2);
pass = hb_parcx(3);
page = hb_parni(4);
charset = hb_parcx(5);
dialect = hb_parni(6);
sprintf(create_db,
"CREATE DATABASE '%s' USER '%s' PASSWORD '%s' PAGE_SIZE = %i DEFAULT CHARACTER SET %s",
db_name, user, pass, page, charset );
if (isc_dsql_execute_immediate(status, &newdb, &trans, 0, create_db, dialect, NULL))
ERREXIT(status);
_retni(1);
}
HB_FUNC(FBCONNECT)
{
ISC_STATUS status[MAX_FIELDS];
isc_db_handle db = NULL;
char *db_connect = NULL;
char *user = NULL;
char *passwd = NULL;
char dpb[128];
int i = 0, len;
PHB_ITEM db_handle;
if (hb_parinfo(1))
db_connect = hb_parcx(1);
if (hb_parinfo(2))
user = hb_parcx(2);
if (hb_parinfo(3))
passwd = hb_parcx(3);
dpb[i++] = isc_dpb_version1;
dpb[i++] = isc_dpb_user_name;
len = strlen(user);
dpb[i++] = (char) len;
strncpy(&(dpb[i]), user, len);
i += len;
dpb[i++] = isc_dpb_password;
len = strlen (passwd);
dpb[i++] = len;
strncpy(&(dpb[i]), passwd, len);
i += len;
if ( isc_attach_database ( status, 0, db_connect, &db, i, dpb ) )
ERREXIT(status);
db_handle = hb_itemPutPtr( NULL, ( void * ) db );
_itemReturn(db_handle);
_itemRelease(db_handle);
}
HB_FUNC(FBCLOSE)
{
isc_db_handle db = NULL;
long status[20];
db = ( isc_db_handle ) hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
if ( isc_detach_database ( status, &db ) )
ERREXIT(status);
_retnl(1);
}
HB_FUNC(FBERROR)
{
int sqlcode;
char msg[MAX_BUFFER];
sqlcode = hb_parni(1);
isc_sql_interprete(sqlcode, msg, 512);
_retc(msg);
}
HB_FUNC(FBSTARTTRANSACTION)
{
isc_db_handle db = NULL;
isc_tr_handle trans = NULL;
long status[MAX_FIELDS];
PHB_ITEM var;
db = ( isc_db_handle ) hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
if (isc_start_transaction(status, &trans, 1, &db, 0, NULL))
ERREXIT(status);
var = hb_itemPutPtr( NULL, ( void * ) trans );
_itemReturn(var);
_itemRelease(var);
}
HB_FUNC(FBCOMMIT)
{
isc_tr_handle trans = NULL;
long status[MAX_FIELDS];
trans = ( isc_db_handle ) hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
if (isc_commit_transaction(status, &trans))
ERREXIT(status);
trans = NULL;
_retnl(1);
}
HB_FUNC(FBROLLBACK)
{
isc_tr_handle trans = NULL;
long status[MAX_FIELDS];
trans = ( isc_db_handle ) hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
if (isc_rollback_transaction(status, &trans))
ERREXIT(status);
trans = NULL;
_retnl(1);
}
HB_FUNC(FBEXECUTE)
{
isc_db_handle db = NULL;
isc_tr_handle trans = NULL;
char *exec_str;
long status[20];
long status_rollback[20];
int dialect;
db = ( isc_db_handle ) hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
exec_str = hb_parcx(2);
dialect = hb_parni(3);
if (hb_parinfo(4)) {
trans = (isc_tr_handle) hb_itemGetPtr( hb_param( 4, HB_IT_POINTER ) );
} else {
if ( isc_start_transaction ( status, &trans, 1, &db, 0, NULL ) )
ERREXIT(status);
}
if (isc_dsql_execute_immediate(status, &db, &trans, 0, exec_str, dialect, NULL)) {
if (! hb_parinfo(4))
isc_rollback_transaction ( status_rollback, &trans );
ERREXIT(status);
}
if (!hb_parinfo(4))
if ( isc_commit_transaction ( status, &trans ) )
ERREXIT(status);
_retnl(1);
}
HB_FUNC(FBQUERY)
{
isc_db_handle db = NULL;
isc_tr_handle trans = NULL;
ISC_STATUS status[MAX_FIELDS];
XSQLDA ISC_FAR * sqlda;
isc_stmt_handle stmt = NULL;
XSQLVAR *var;
char sel_str[MAX_LEN];
int dialect;
int n, i, dtype;
int num_cols;
ITEM qry_handle;
ITEM temp;
ITEM aTemp;
ITEM aNew;
ITEM itemSqlname;
ITEM itemSqltype;
ITEM itemSqllen ;
ITEM itemSqlscale;
ITEM itemRelname;
db = ( isc_db_handle ) hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
strcpy(sel_str, hb_parcx(2));
if (hb_parinfo(3)) {
dialect = hb_parni(3);
} else {
dialect = DIALECT;
}
if (hb_parinfo(4)) {
trans = (isc_tr_handle) hb_itemGetPtr( hb_param( 4, HB_IT_POINTER ) );
} else if ( isc_start_transaction ( status, &trans, 1, &db, 0, NULL ) )
ERREXIT(status);
// Allocate an output SQLDA. Just to check number of columns
sqlda = ( XSQLDA * ) hb_xgrab( XSQLDA_LENGTH ( 1 ) );
sqlda->sqln = 1;
sqlda->version = 1;
// Allocate a statement
if (isc_dsql_allocate_statement(status, &db, &stmt))
ERREXIT(status);
// Prepare the statement.
if (isc_dsql_prepare(status, &trans, &stmt, 0, sel_str, dialect, sqlda))
ERREXIT(status);
// Describe sql contents
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status);
num_cols = sqlda->sqld;
aNew = _itemArrayNew( num_cols );
// Relocate necessary number of columns
if ( sqlda->sqld > sqlda->sqln ) {
hb_xfree( sqlda );
n = sqlda->sqld;
sqlda = ( XSQLDA * ) hb_xgrab( XSQLDA_LENGTH ( n ) );
sqlda->sqln = n;
sqlda->version = 1;
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status);
}
for ( i = 0, var = sqlda->sqlvar; i < sqlda->sqld; i++, var++ ) {
dtype = ( var->sqltype & ~1 );
switch ( dtype ) {
case SQL_VARYING:
var->sqltype = SQL_TEXT;
var->sqldata = ( char * ) hb_xgrab( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_TEXT:
var->sqldata = ( char * ) hb_xgrab( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_LONG:
var->sqltype = SQL_LONG;
var->sqldata = ( char * ) hb_xgrab( sizeof ( long ) );
break;
default:
var->sqldata = ( char * ) hb_xgrab( sizeof ( char ) * var->sqllen );
break;
}
if ( var->sqltype & 1 ) {
var->sqlind = ( short * ) hb_xgrab( sizeof ( short ) );
}
aTemp = _itemArrayNew( 5 );
itemSqlname = _itemPutC( NULL, sqlda->sqlvar[i].sqlname );
_itemArrayPut( aTemp, 1, itemSqlname );
itemSqltype = _itemPutNL( NULL, (long)dtype );
_itemArrayPut( aTemp, 2, itemSqltype );
itemSqllen = _itemPutNL( NULL, sqlda->sqlvar[i].sqllen );
_itemArrayPut( aTemp, 3, itemSqllen );
itemSqlscale = _itemPutNL( NULL, sqlda->sqlvar[i].sqlscale );
_itemArrayPut( aTemp, 4, itemSqlscale );
itemRelname = _itemPutC( NULL, sqlda->sqlvar[i].relname );
_itemArrayPut( aTemp, 5, itemRelname );
_itemRelease( itemSqlname );
_itemRelease( itemSqltype );
_itemRelease( itemSqllen );
_itemRelease( itemSqlscale );
_itemRelease( itemRelname );
_itemArrayPut( aNew, i+1, aTemp );
_itemRelease( aTemp );
}
if ( !sqlda->sqld ) {
// Execute and commit non-select querys
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, NULL ) )
ERREXIT(status);
} else {
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, sqlda ) )
ERREXIT(status);
}
qry_handle = _itemArrayNew(6);
temp = hb_itemPutPtr( NULL, ( void * ) stmt );
hb_arraySet(qry_handle, 1, temp);
_itemRelease(temp);
temp = hb_itemPutPtr( NULL, ( void * ) sqlda );
hb_arraySet(qry_handle, 2, temp);
_itemRelease(temp);
if (! hb_parinfo(4))
{
temp = hb_itemPutPtr( NULL, ( void * ) trans );
hb_arraySet(qry_handle, 3, temp);
_itemRelease(temp);
}
temp = _itemPutNL(NULL, (long) num_cols);
hb_arraySet(qry_handle, 4, temp);
_itemRelease(temp);
temp = _itemPutNL(NULL, (long) dialect);
hb_arraySet(qry_handle, 5, temp);
_itemRelease(temp);
hb_arraySet(qry_handle, 6, aNew);
_itemReturn(qry_handle);
_itemRelease(qry_handle);
_itemRelease(aNew);
}
HB_FUNC(FBFETCH)
{
isc_stmt_handle stmt = NULL;
ISC_STATUS status[MAX_FIELDS];
XSQLDA ISC_FAR * sqlda;
long fetch_stat;
int dialect;
PHB_ITEM aParam ;
if (ISARRAY( 1 ) )
{
aParam = hb_param(1,HB_IT_ARRAY);
stmt = ( isc_stmt_handle ) hb_itemGetPtr(hb_itemArrayGet( aParam, 1 ));
sqlda = ( XSQLDA ISC_FAR * ) hb_itemGetPtr(hb_itemArrayGet( aParam, 2 ));
dialect = hb_itemGetNI(hb_itemArrayGet( aParam, 5 ));
fetch_stat = isc_dsql_fetch(status, &stmt, dialect, sqlda);
if (fetch_stat != 100L)
ERREXIT(status);
}
_retnl(fetch_stat);
}
HB_FUNC(FBFREE)
{
isc_stmt_handle stmt = NULL;
isc_tr_handle trans = NULL;
ISC_STATUS status[MAX_FIELDS];
XSQLDA ISC_FAR * sqlda;
PHB_ITEM aParam ;
if (ISARRAY( 1 ) )
{
aParam = hb_param(1,HB_IT_ARRAY);
stmt = ( isc_stmt_handle ) hb_itemGetPtr(hb_itemArrayGet( aParam, 1 ));
sqlda = ( XSQLDA ISC_FAR * ) hb_itemGetPtr(hb_itemArrayGet( aParam, 2 ));
trans = ( isc_tr_handle ) hb_itemGetPtr( hb_itemArrayGet( aParam, 3 ));
if (isc_dsql_free_statement(status, &stmt, DSQL_drop))
ERREXIT(status);
if (trans)
if (isc_commit_transaction(status, &trans))
ERREXIT(status);
if ( sqlda )
hb_xfree( sqlda );
_retnl(1);
}
else
_retnl(0);
}
HB_FUNC(FBGETDATA)
{
int pos;
short dtype;
char data[MAX_BUFFER], *p;
char date_s[25];
struct tm times;
XSQLVAR *var;
XSQLDA ISC_FAR * sqlda;
ISC_STATUS status[MAX_FIELDS];
ISC_QUAD *blob_id;
PHB_ITEM aParam ;
PHB_ITEM temp;
aParam = hb_param(1,HB_IT_ARRAY);
sqlda = ( XSQLDA ISC_FAR * ) hb_itemGetPtr(hb_itemArrayGet( aParam, 2 ));
pos = (int) hb_parnl(2);
pos--;
if ( ( pos + 1 ) > sqlda->sqln )
ERREXIT(status);
var = sqlda->sqlvar;
var += pos;
dtype = var->sqltype & ~1;
p = data;
if ( ( var->sqltype & 1 ) && ( *var->sqlind < 0 ) ) {
/* null field */
_ret();
} else {
switch ( dtype ) {
case SQL_TEXT:
case SQL_VARYING:
_retclen( var->sqldata, var->sqllen );
break;
case SQL_TIMESTAMP:
isc_decode_timestamp ( ( ISC_TIMESTAMP ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d %02d:%02d:%02d.%04lu",
times.tm_year + 1900,
times.tm_mon + 1,
times.tm_mday,
times.tm_hour,
times.tm_min,
times.tm_sec,
( ( ISC_TIMESTAMP * ) var->sqldata )->timestamp_time % 10000 );
sprintf ( p, "%*s ", 24, date_s );
_retc(p);
break;
case SQL_TYPE_DATE:
isc_decode_sql_date ( ( ISC_DATE ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d", times.tm_year + 1900, times.tm_mon + 1, times.tm_mday );
sprintf ( p, "%*s ", 8, date_s );
_retc(p);
break;
case SQL_TYPE_TIME:
isc_decode_sql_time ( ( ISC_TIME ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%02d:%02d:%02d.%04lu",
times.tm_hour,
times.tm_min,
times.tm_sec, ( *( ( ISC_TIME * ) var->sqldata ) ) % 10000 );
sprintf ( p, "%*s ", 13, date_s );
_retc(p);
break;
case SQL_BLOB:
blob_id = ( ISC_QUAD * ) var->sqldata;
temp = hb_itemPutPtr( NULL, ( void * ) blob_id );
_itemReturn(temp);
_itemRelease(temp);
break;
case SQL_SHORT:
case SQL_LONG:
case SQL_INT64:
{
ISC_INT64 value;
short field_width;
short dscale;
switch (dtype)
{
case SQL_SHORT:
value = (ISC_INT64) *(short ISC_FAR *) var->sqldata;
field_width = 6;
break;
case SQL_LONG:
value = (ISC_INT64) *(long ISC_FAR *) var->sqldata;
field_width = 11;
break;
case SQL_INT64:
value = (ISC_INT64) *(ISC_INT64 ISC_FAR *) var->sqldata;
field_width = 21;
break;
}
dscale = var->sqlscale;
if (dscale < 0)
{
ISC_INT64 tens;
short i;
tens = 1;
for (i = 0; i > dscale; i--)
tens *= 10;
if (value >= 0)
sprintf (p, "%*" ISC_INT64_FORMAT "d.%0*" ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
(ISC_INT64) value / tens,
-dscale,
(ISC_INT64) value % tens);
else if ((value / tens) != 0)
sprintf (p, "%*" ISC_INT64_FORMAT "d.%0*" ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
(ISC_INT64) (value / tens),
-dscale,
(ISC_INT64) -(value % tens));
else
sprintf (p, "%*s.%0*" ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
"-0",
-dscale,
(ISC_INT64) -(value % tens));
}
else if (dscale)
sprintf (p, "%*" ISC_INT64_FORMAT "d%0*d", field_width, (ISC_INT64) value, dscale, 0);
else
sprintf (p, "%*" ISC_INT64_FORMAT "d", field_width, (ISC_INT64) value);
};
_retc(p);
break;
case SQL_FLOAT:
sprintf(p, "%15g ", *(float ISC_FAR *) (var->sqldata));
_retc(p);
break;
case SQL_DOUBLE:
sprintf(p, "%24f ", *(double ISC_FAR *) (var->sqldata));
_retc(p);
break;
default:
_ret();
break;
}
}
}
HB_FUNC(FBGETBLOB)
{
ISC_STATUS status[MAX_FIELDS];
isc_db_handle db = NULL;
isc_tr_handle trans = NULL;
isc_blob_handle blob_handle = NULL;
short blob_seg_len;
char *blob_segment;
ISC_QUAD *blob_id;
char p[MAX_BUFFER];
long blob_stat;
ITEM temp;
ITEM aNew;
db = ( isc_db_handle ) hb_itemGetPtr( hb_param( 1, HB_IT_POINTER ) );
blob_id = ( ISC_QUAD * ) hb_itemGetPtr( hb_param( 2, HB_IT_POINTER ) );
if (_parinfo(3)) {
trans = (isc_tr_handle) hb_itemGetPtr( hb_param( 3, HB_IT_POINTER ) );
} else {
if ( isc_start_transaction ( status, &trans, 1, &db, 0, NULL ) ) {
ERREXIT(status);
}
}
if (isc_open_blob2(status, &db, &trans, &blob_handle, blob_id, 0, NULL))
ERREXIT(status);
// Get blob segments and their lengths and print each segment.
blob_stat = isc_get_segment(status, &blob_handle,
(unsigned short ISC_FAR *) &blob_seg_len,
sizeof(blob_segment), blob_segment);
if (blob_stat == 0 || status[1] == isc_segment)
aNew = _itemArrayNew( 0 );
while (blob_stat == 0 || status[1] == isc_segment)
{
//p = ( char * ) hb_xgrab( blob_seg_len + 1 );
sprintf( p, "%*.*s", blob_seg_len, blob_seg_len, blob_segment);
temp = _itemPutC( NULL, p );
hb_arrayAdd( aNew, temp ) ;
_itemRelease(temp);
//hb_xfree(p);
blob_stat = isc_get_segment(status, &blob_handle,
(unsigned short ISC_FAR *)&blob_seg_len,
sizeof(blob_segment), blob_segment);
}
if (isc_close_blob(status, &blob_handle)) {
_itemRelease(aNew);
ERREXIT(status);
}
if (!_parinfo(3))
if ( isc_commit_transaction ( status, &trans ) )
ERREXIT(status);
_itemReturn(aNew);
_itemRelease(aNew);
}

78
harbour/contrib/firebird/make_b32.bat Normal file
View File

@@ -0,0 +1,78 @@
@echo off
rem
rem $Id: make_b32.bat 7974 2007-11-14 23:24:27Z vszakats $
rem
rem ---------------------------------------------------------------
rem IMPORTANT: You'll need Firebird headers and this envvar
rem to be set to successfully build this library:
rem set FBDIR=C:\Firebird
rem ---------------------------------------------------------------
rem ---------------------------------------------------------------
rem This is a generic template file, if it doesn't fit your own needs
rem please DON'T MODIFY IT.
rem
rem Instead, make a local copy and modify that one, or make a call to
rem this batch file from your customized one. [vszakats]
rem
rem Set any of the below settings to customize your build process:
rem set HB_MAKE_PROGRAM=
rem set HB_MAKE_FLAGS=
rem ---------------------------------------------------------------
if "%HB_DLL_DIR%" == "" set HB_DLL_DIR=%SystemRoot%\system32
if "%HB_CC_NAME%" == "" set HB_CC_NAME=b32
if "%HB_MAKE_PROGRAM%" == "" set HB_MAKE_PROGRAM=make.exe
set HB_MAKEFILE=..\mtpl_%HB_CC_NAME%.mak
set C_USR=%C_USR% -I%FBDIR%\include -DHB_OS_WIN_32_USED
rem ---------------------------------------------------------------
rem Save the user value, force silent file overwrite with COPY
rem (not all Windows versions support the COPY /Y flag)
set HB_ORGENV_COPYCMD=%COPYCMD%
set COPYCMD=/Y
rem ---------------------------------------------------------------
if "%1" == "clean" goto CLEAN
if "%1" == "CLEAN" goto CLEAN
if "%1" == "install" goto INSTALL
if "%1" == "INSTALL" goto INSTALL
:BUILD
implib ..\..\lib\%HB_CC_NAME%\fbclient.lib %FBDIR%\bin\fbclient.dll
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% %1 %2 %3 > make_%HB_CC_NAME%.log
if errorlevel 1 notepad make_%HB_CC_NAME%.log
goto EXIT
:CLEAN
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% CLEAN > make_%HB_CC_NAME%.log
if exist make_%HB_CC_NAME%.log del make_%HB_CC_NAME%.log > nul
if exist inst_%HB_CC_NAME%.log del inst_%HB_CC_NAME%.log > nul
goto EXIT
:INSTALL
set _HB_INSTALL_PREFIX=%HB_INSTALL_PREFIX%
if "%_HB_INSTALL_PREFIX%" == "" set _HB_INSTALL_PREFIX=..\..
set _HB_LIB_INSTALL=%HB_LIB_INSTALL%
if "%_HB_LIB_INSTALL%" == "" set _HB_LIB_INSTALL=%_HB_INSTALL_PREFIX%\lib
copy ..\..\lib\%HB_CC_NAME%\fbclient.lib %_HB_LIB_INSTALL%
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% INSTALL > nul
goto EXIT
:EXIT
rem ---------------------------------------------------------------
rem Restore user value
set COPYCMD=%HB_ORGENV_COPYCMD%

94
harbour/contrib/firebird/make_vc.bat Normal file
View File

@@ -0,0 +1,94 @@
@echo off
rem
rem $Id: make_vc.bat 7974 2007-11-14 23:24:27Z vszakats $
rem
rem ---------------------------------------------------------------
rem IMPORTANT: You'll need Firebird headers and this envvar
rem to be set to successfully build this library:
rem set FBDIR=C:\Firebird
rem ---------------------------------------------------------------
rem ---------------------------------------------------------------
rem This is a generic template file, if it doesn't fit your own needs
rem please DON'T MODIFY IT.
rem
rem Instead, make a local copy and modify that one, or make a call to
rem this batch file from your customized one. [vszakats]
rem
rem Set any of the below settings to customize your build process:
rem set HB_MAKE_PROGRAM=
rem set HB_MAKE_FLAGS=
rem ---------------------------------------------------------------
if "%HB_DLL_DIR%" == "" set HB_DLL_DIR=%SystemRoot%\system32
if "%HB_CC_NAME%" == "" set HB_CC_NAME=vc
if "%HB_MAKE_PROGRAM%" == "" set HB_MAKE_PROGRAM=nmake.exe
set HB_MAKEFILE=..\mtpl_%HB_CC_NAME%.mak
set C_USR=%C_USR% -I%FBDIR%\include -DHB_OS_WIN_32_USED
rem ---------------------------------------------------------------
rem Save the user value, force silent file overwrite with COPY
rem (not all Windows versions support the COPY /Y flag)
set HB_ORGENV_COPYCMD=%COPYCMD%
set COPYCMD=/Y
rem ---------------------------------------------------------------
if "%1" == "clean" goto CLEAN
if "%1" == "CLEAN" goto CLEAN
if "%1" == "install" goto INSTALL
if "%1" == "INSTALL" goto INSTALL
:BUILD
rem ---------------------------------------------------------------
rem This .dll to .lib conversion needs GNU sed.exe in the path
rem ---------------------------------------------------------------
echo./[ \t]*ordinal hint/,/^^[ \t]*Summary/{> _temp.sed
echo. /^^[ \t]\+[0-9]\+/{>> _temp.sed
echo. s/^^[ \t]\+[0-9]\+[ \t]\+[0-9A-Fa-f]\+[ \t]\+[0-9A-Fa-f]\+[ \t]\+\(.*\)/\1/p>> _temp.sed
echo. }>> _temp.sed
echo.}>> _temp.sed
DUMPBIN /EXPORTS %FBDIR%\bin\fbclient.dll > _dump.tmp
echo.LIBRARY %FBDIR%\bin\fbclient.dll > _temp.def
echo.EXPORTS >> _temp.def
sed -nf _temp.sed < _dump.tmp >> _temp.def
LIB /MACHINE:X86 /DEF:_temp.def /OUT:..\..\lib\%HB_CC_NAME%\fbclient.lib
del _dump.tmp
del _temp.def
del _temp.sed
rem ---------------------------------------------------------------
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% %1 %2 %3 > make_%HB_CC_NAME%.log
if errorlevel 1 notepad make_%HB_CC_NAME%.log
goto EXIT
:CLEAN
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% CLEAN > make_%HB_CC_NAME%.log
if exist make_%HB_CC_NAME%.log del make_%HB_CC_NAME%.log > nul
if exist inst_%HB_CC_NAME%.log del inst_%HB_CC_NAME%.log > nul
goto EXIT
:INSTALL
set _HB_INSTALL_PREFIX=%HB_INSTALL_PREFIX%
if "%_HB_INSTALL_PREFIX%" == "" set _HB_INSTALL_PREFIX=..\..
set _HB_LIB_INSTALL=%HB_LIB_INSTALL%
if "%_HB_LIB_INSTALL%" == "" set _HB_LIB_INSTALL=%_HB_INSTALL_PREFIX%\lib
copy ..\..\lib\%HB_CC_NAME%\fbclient.lib %_HB_LIB_INSTALL%
%HB_MAKE_PROGRAM% %HB_MAKE_FLAGS% -f %HB_MAKEFILE% INSTALL > nul
goto EXIT
:EXIT
rem ---------------------------------------------------------------
rem Restore user value
set COPYCMD=%HB_ORGENV_COPYCMD%

55
harbour/contrib/firebird/readme.txt Normal file
View File

@@ -0,0 +1,55 @@
README 23/12/2003 - Harbour Low Level api for Firebird and Interbase RDBMS
This work is not finished yet. It's to be seem like Harbour TMysql routines.
To use with bcc, you need import library, ex: implib fbclient.lib fbclient.dll or implib gds32.lib gds32.dll.
On Linux you will need link fbclient.so, this can be found usually at /usr/lib.
For full firebird documentation look at:
Firebird home: http://firebird.sourceforge.net/index.php
Api: http://www.ibphoenix.com/downloads/60ApiGuide.zip
Data Definition: http://www.ibphoenix.com/downloads/60DataDef.zip
Language Reference: http://www.ibphoenix.com/downloads/60LangRef.zip
Developers guide: http://www.ibphoenix.com/downloads/60DevGuide.zip
The Class implementation has no all implementation like TMysql has, because Firebird it's diferent.
For example, you can't navigate in records like Mysql do, ex: Getrow( number of row ), in firebird you can
just go forward.
You will need ibase.h, it can be found at firebird/include
FILES:
firebird.c - Low level api
TFirebird.prg - Class implementation, it's to be seems like TMysql.
tests\simple.prg - Simple test class
tests\stress.prg - Stress test class
tests\test.prg - Testing using only low level api
tests\test.c - Pure C code to test firebird access.
TODO:
Full implementation of blob control. For now, we have only partial control, only for text blobs (sybtype 1).
Improve Insert and Update commands using DSQL.
Implements to do:
FBOpenBlob( blob_id )
FBReadBlob(blob_id, string, segment_size)
FBCreateBlob()
FBPutBlob(blob_id, string, segment_size)
FBCloseBlob( blob_id )
BUGS:
Fix a few windows gpf and linux segment fault. I Need some help to find what's going on here.
That's all folks and sorry my poor english
Rodrigo Moreno - rodrigo_moreno@yahoo.com

32
harbour/contrib/firebird/test/Makefile Normal file
View File

@@ -0,0 +1,32 @@
#
# $Id: Makefile,v 1.1 2003/12/31 00:24:35 lculik Exp $
#
ifeq ($(HB_MAIN),)
HB_MAIN = std
endif
ROOT = ../../../
CONTRIBS=\
firebird \
PRG_SOURCES=\
simple.prg \
PRG_MAIN=\
simple.prg
LIBS=\
debug \
vm \
rtl \
lang \
rdd \
rtl \
vm \
macro \
common \
fbclient \
include $(TOP)$(ROOT)config/bin.cf

80
harbour/contrib/firebird/test/bld_b32.bat Normal file
View File

@@ -0,0 +1,80 @@
@echo off
rem
rem $Id: bld_b32.bat 7941 2007-11-11 01:42:42Z vszakats $
rem
if A%1 == A GOTO :SYNTAX
if NOT EXIST %1.prg GOTO :NOEXIST
ECHO Build: Compiling...
set hdir=..\..\..
%hdir%\bin\harbour %1 /w /n /i..\include;%hdir%\include %2 %3 > bld_b32.log
type bld_b32.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT
echo -O2 -e%1.exe -I%hdir%\include %1.c > bld_b32.mak
bcc32 -M -c @bld_b32.mak
:ENDCOMPILE
echo c0w32.obj + > bld_b32.mak
echo %1.obj, + >> bld_b32.mak
echo %1.exe, + >> bld_b32.mak
echo %1.map, + >> bld_b32.mak
echo %hdir%\lib\rtl.lib + >> bld_b32.mak
echo %hdir%\lib\vm.lib + >> bld_b32.mak
echo %hdir%\lib\gtwin.lib + >> bld_b32.mak
echo %hdir%\lib\lang.lib + >> bld_b32.mak
echo %hdir%\lib\macro.lib + >> bld_b32.mak
echo %hdir%\lib\rdd.lib + >> bld_b32.mak
echo %hdir%\lib\dbfntx.lib + >> bld_b32.mak
echo %hdir%\lib\dbfcdx.lib + >> bld_b32.mak
echo %hdir%\lib\debug.lib + >> bld_b32.mak
echo %hdir%\lib\common.lib + >> bld_b32.mak
echo %hdir%\lib\pp.lib + >> bld_b32.mak
echo %hdir%\lib\hbsix.lib + >> bld_b32.mak
echo %hdir%\lib\dbffpt.lib + >> bld_b32.mak
echo %hdir%\lib\fbclient.lib + >> bld_b32.mak
echo %hdir%\lib\firebird.lib + >> bld_b32.mak
rem Uncomment these two lines to use Advantage RDD
rem echo %hdir%\lib\rddads.lib + >> bld_b32.mak
rem echo %hdir%\lib\ace32.lib + >> bld_b32.mak
echo cw32.lib + >> bld_b32.mak
echo import32.lib, >> bld_b32.mak
ECHO Build: Linking...
rem Use these flags to avoid the console window creation
rem ilink32 -Gn -aa -Tpe -s @bld_b32.mak
ilink32 -Gn -Tpe -s @bld_b32.mak
rem delete temporary files
del %1.c
del %1.obj
if exist %1.map del %1.map
if exist %1.tds del %1.tds
del bld_b32.mak
del bld_b32.log
IF ERRORLEVEL 1 GOTO LINKERROR
ECHO Build: Done.
%1
GOTO EXIT
ECHO
:LINKERROR
rem if exist meminfo.txt notepad meminfo.txt
rem PAUSE * Linking errors *
GOTO EXIT
:SYNTAX
ECHO SYNTAX: bld_b32 [Program] {-- Don't specify .prg extension
GOTO EXIT
:NOEXIST
ECHO Build: The specified %1.prg does not exist
:EXIT

188
harbour/contrib/firebird/test/simple.prg Normal file
View File

@@ -0,0 +1,188 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
#include "common.ch"
Function main()
Local oServer, oQuery, oRow, i, x, aTables, aStruct, aKey
Local cServer := '192.168.1.33:D:\firebird\test\test.gdb'
Local cUser := 'sysdba'
Local cPass := 'masterkey'
Local nDialect := 1
Local cQuery
if File('test.gdb')
FErase('test.gdb')
end
? FBCreateDB('test.gdb', cuser, cpass, 1024, 'ASCII', nDialect )
? "Connecting..."
oServer := TFBServer():New(cServer, cUser, cPass, nDialect)
if oServer:NetErr()
? oServer:Error()
quit
end
? 'Tables...'
For x := 1 to 1
aTables := oServer:ListTables()
For i := 1 to Len(aTables)
? aTables[i]
next
Next
? 'Using implicit transaction...'
if oServer:TableExists('TEST')
oServer:Execute('DROP TABLE Test')
oServer:Execute('DROP DOMAIN boolean_field')
end
? 'Creating domain for boolean fields...'
oServer:Execute('create domain boolean_field as smallint default 0 not null check (value in (0,1))')
oServer:StartTransaction()
? 'Creating test table...'
cQuery := 'CREATE TABLE test('
cQuery += ' Code SmallInt not null primary key, '
cQuery += ' dept Integer, '
cQuery += ' Name Varchar(40), '
cQuery += ' Sales boolean_field, '
cQuery += ' Tax Float, '
cQuery += ' Salary Double Precision, '
cQuery += ' Budget Numeric(12,2), '
cQuery += ' Discount Decimal(5,2), '
cQuery += ' Creation Date, '
cQuery += ' Description blob sub_type 1 segment size 40 ) '
oServer:Execute(cQuery)
if oServer:neterr()
? oServer:Error()
end
oServer:Commit()
oQuery := oServer:Query('SELECT code, dept, name, sales, salary, creation FROM test')
wait
? 'Structure of test table'
aStruct := oServer:TableStruct('test')
For i := 1 to Len(aStruct)
?
For x := 1 to Len(aStruct[i])
?? aStruct[i,x]
Next
next
? 'Inserting, declared transaction control '
oServer:StartTransaction()
For i := 1 to 100
cQuery := 'INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) '
cQuery += 'VALUES( ' + str(i) + ', 2, "TEST", 1, 5, 3000, 1500.2, 7.5, "12-22-2003", "Short Description about what ? ")'
oServer:Execute(cQuery)
if oServer:neterr()
? oServer:error()
end
Next
oServer:Commit()
oQuery := oServer:Query('SELECT code, name, description, sales FROM test')
aStruct := oQuery:Struct()
For i := 1 to Len(aStruct)
? aStruct[i,1], aStruct[i,2], aStruct[i,3], aStruct[i,4]
Next
aKey := oQuery:GetKeyField()
? "Fields: ", oQuery:Fcount(), "Primary Key: ", aKey[1]
oRow := oQuery:Blank()
? oRow:FCount(), ;
oRow:Fieldpos('code'), ;
oRow:Fieldget(1), ;
oRow:Fieldname(1), ;
oRow:Fieldtype(1), ;
oRow:Fielddec(1), ;
oRow:Fieldlen(1), ;
len(oRow:Getkeyfield())
oRow:Fieldput(1, 150)
oRow:Fieldput(2, 'MY TEST')
? oRow:Fieldget(1), oRow:Fieldget(2)
? oServer:Append(oRow)
? oServer:Delete(oQuery:blank(), 'code = 200')
? oServer:Execute('error caused intentionaly')
DO WHILE ! oQuery:Eof()
oQuery:Skip()
? oQuery:Fieldget(oQuery:Fieldpos('code')), ;
oQuery:Fieldget(4), ;
oQuery:Fieldget(2), ;
oQuery:Fieldname(1),;
oQuery:Fieldtype(1), ;
oQuery:Fielddec(1), ;
oQuery:Fieldlen(1),;
oQuery:Fieldget(3)
if oQuery:Recno() == 50
oRow := oQuery:getrow()
oRow:Fieldput(2, 'My Second test')
? 'Update: ', oServer:Update(oRow)
end
if oQuery:Recno() == 60
oRow := oQuery:getrow()
? 'Delete: ', oServer:Delete(oRow)
end
END
? 'Delete: ', oServer:Delete(oQuery:Blank(), 'code = 70')
oQuery:Refresh()
DO WHILE oQuery:Fetch()
oRow := oQuery:getrow()
? oRow:Fieldget(oRow:Fieldpos('code')), ;
oRow:Fieldget(4), ;
oRow:Fieldget(2), ;
oRow:Fieldname(1),;
oRow:Fieldtype(1), ;
oRow:Fielddec(1), ;
oRow:Fieldlen(1),;
oRow:Fieldget(3)
END
oQuery:Destroy()
oServer:Destroy()
? "Closing..."
return nil

134
harbour/contrib/firebird/test/stress.prg Normal file
View File

@@ -0,0 +1,134 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
/* VERY IMPORTANT: Don't use this querys as sample, they are used for stress tests !!! */
Function Main()
Local oServer, oQuery, oRow, i, x
Local cServer := '192.168.1.33:D:\firebird\test\test2.gdb'
Local cUser := 'sysdba'
Local cPass := 'masterkey'
Local nDialect := 1
Local cQuery
CLEAR SCREEN
if ! File('test2.gdb') .and. .F.
? FBCreateDB('test2.gdb', cuser, cpass, 1024, 'WIN1251', nDialect )
end
? "Connecting..."
oServer := TFBServer():New(cServer, cUser, cPass, nDialect)
if oServer:NetErr()
? oServer:Error()
quit
end
if oServer:TableExists('test')
? oServer:Execute('DROP TABLE Test')
? oServer:Execute('DROP DOMAIN boolean_field')
end
? 'Creating domain for boolean fields...'
? oServer:Execute('create domain boolean_field as smallint default 0 not null check (value in (0,1))')
? 'Creating test table...'
cQuery := 'CREATE TABLE test('
cQuery += ' Code SmallInt not null primary key, '
cQuery += ' dept Integer, '
cQuery += ' Name Varchar(40), '
cQuery += ' Sales boolean_field, '
cQuery += ' Tax Float, '
cQuery += ' Salary Double Precision, '
cQuery += ' Budget Numeric(12,2), '
cQuery += ' Discount Decimal(5,2), '
cQuery += ' Creation Date, '
cQuery += ' Description blob sub_type 1 segment size 40 ) '
? oServer:Execute(cQuery)
quit
oQuery := oServer:Query('SELECT code, dept, name, sales, salary, creation FROM test')
oServer:StartTransaction()
For i := 1 to 10000
@ 15,0 say 'Inserting values....' + str(i)
oRow := oQuery:Blank()
oRow:Fieldput(1, i)
oRow:Fieldput(2, i+1)
oRow:Fieldput(3, 'DEPARTMENT NAME ' + strzero(i) )
oRow:Fieldput(4, (mod(i,10) == 0) )
oRow:Fieldput(5, 3000 + i )
oRow:fieldput(6, Date() )
oServer:Append(oRow)
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
For i := 5000 to 7000
@ 16,0 say 'Deleting values....' + str(i)
oRow := oQuery:Blank()
oServer:Delete(oRow, 'code = ' + str(i))
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
For i := 2000 to 3000
@ 17,0 say 'Updating values....' + str(i)
oRow := oQuery:Blank()
oRow:Fieldput(5, 4000+i)
oServer:update(oRow, 'code = ' + str(i))
if mod(i,100) == 0
oServer:Commit()
oServer:StartTransaction()
end
Next
oQuery := oServer:Query('SELECT sum(salary) sum_salary FROM test WHERE code between 1 and 4000')
if ! oQuery:Neterr()
oQuery:Fetch()
@ 18,0 say 'Sum values....' + Str(oQuery:Fieldget(1))
oQuery:Destroy()
end
x := 0
For i := 1 to 4000
oQuery := oServer:Query('SELECT * FROM test WHERE code = ' + str(i))
if ! oQuery:Neterr()
oQuery:Fetch()
oRow := oQuery:getrow()
oQuery:destroy()
x += oRow:fieldget(oRow:fieldpos('salary'))
@ 19,0 say 'Sum values....' + str(x)
end
Next
oServer:Destroy()
? "Closing..."
return nil

77
harbour/contrib/firebird/test/test.prg Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
#include "common.ch"
Function Main()
nDialect := 1
if File('test.gdb')
FErase('test.gdb')
end
? FBCreateDB('test.gdb','sysdba', 'masterkey', 1024, 'ASCII', nDialect )
/* Connect rdbms */
db := FBConnect("127.0.0.1:d:\firebird\test\test.gdb", "sysdba", "masterkey")
if ISNUMBER(db)
? 'Error'
quit
end
? FBExecute(db, 'sldjfs;ldjs;djf', dialect)
? FBClose(db)
trans := FBStartTransaction(db)
qry := FBQuery(db, 'create table teste (code smallint)', dialect, trans)
FBCommit(trans)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 1")', dialect, trans)
? "Status no Rollback: ", FBRollback(trans)
trans := FBStartTransaction(db)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 2")', dialect, trans )
? "Status commit: ", FBCommit(trans)
? "Status Execute: ", FBExecute( db, 'insert into customer(customer) values ("test 3")', dialect )
// FIX WINDOWS GPF BELOW
qry := FBQuery(db, "SELECT * FROM sales", dialect)
num_cols := qry[4]
columns := qry[6]
For x := 1 to num_cols
? x, "> "
For y := 1 to len(columns[x])
?? columns[x,y], ' '
Next
Next
? '---'
do while (fetch_stat := FBFetch(qry)) == 0
? fetch_stat
for x := 1 to num_cols
?? FBGetData(qry,x), ', '
next
end
? 'Fetch code:', fetch_stat
? "Status Free sql: ", FBFree(qry)
/* Close connection with rdbms */
? "Status Fechar Database: ", FBClose(db)
Return Nil

403
harbour/contrib/firebird/test/testapi.c Normal file
View File

@@ -0,0 +1,403 @@
/*
* $Id: atrepl.c 7583 2007-07-06 21:17:36Z druzus $
*/
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <time.h>
#include <ibase.h>
#include <iberror.h>
#ifndef ISC_INT64_FORMAT
#if (defined(_MSC_VER) && defined(WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__))
#define ISC_INT64_FORMAT "I64"
#else
#define ISC_INT64_FORMAT "ll"
#endif
#endif
#define USER "sysdba"
#define PASSWORD "masterkey"
#define DATABASE "192.168.1.33:d:\\fontes\\lixo\\test.gdb"
#define ERREXIT(status, rc) {isc_print_status(status); return rc;}
#define MAX_BUFFER 1024
int execute( char *exec_str );
int query( char *sel_str );
int fetch( void );
int qclose( void );
char *getdata(int pos);
isc_db_handle db = NULL;
int dialect = 1;
XSQLDA ISC_FAR * sqlda;
isc_stmt_handle stmt = NULL;
isc_tr_handle trans = NULL;
int main ()
{
char dpb[48];
int i = 0, len;
long status[20];
dpb[i++] = isc_dpb_version1;
dpb[i++] = isc_dpb_user_name;
len = strlen(USER);
dpb[i++] = (char) len;
strncpy(&(dpb[i]), USER, len);
i += len;
dpb[i++] = isc_dpb_password;
len = strlen (PASSWORD);
dpb[i++] = len;
strncpy(&(dpb[i]), PASSWORD, len);
i += len;
if (isc_attach_database(status, 0, DATABASE, &db, i, dpb))
ERREXIT(status, 1);
execute("DROP TABLE TESTE");
execute("CREATE TABLE TESTE (code smallint)");
execute("INSERT INTO TESTE (code) VALUES (100)");
query("SELECT * FROM TESTE");
while (fetch() == 0)
printf("%s\n", getdata(0));
qclose();
if (isc_detach_database(status, &db))
ERREXIT(status, 1);
return 1;
}
int execute( char *exec_str )
{
isc_tr_handle trans = NULL;
long status[20];
if (isc_start_transaction(status, &trans, 1, &db, 0, NULL))
ERREXIT(status, 1);
if (isc_dsql_execute_immediate(status, &db, &trans, 0, exec_str, dialect, NULL))
ERREXIT(status, 1);
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
return 1;
}
int query( char *sel_str )
{
ISC_STATUS status[20];
XSQLVAR *var;
int n, i, dtype;
if ( isc_start_transaction ( status, &trans, 1, &db, 0, NULL ) )
ERREXIT(status, 1);
// Allocate an output SQLDA. Just to check number of columns
sqlda = ( XSQLDA * ) malloc( XSQLDA_LENGTH ( 1 ) );
sqlda->sqln = 1;
sqlda->version = 1;
// Allocate a statement
if (isc_dsql_allocate_statement(status, &db, &stmt))
ERREXIT(status, 1);
// Prepare the statement.
if (isc_dsql_prepare(status, &trans, &stmt, 0, sel_str, dialect, sqlda))
ERREXIT(status, 1);
// Describe sql contents
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status, 1);
// Relocate necessary number of columns
if ( sqlda->sqld > sqlda->sqln ) {
free( sqlda );
n = sqlda->sqld;
sqlda = ( XSQLDA * ) malloc( XSQLDA_LENGTH ( n ) );
sqlda->sqln = n;
sqlda->version = 1;
if (isc_dsql_describe(status, &stmt, dialect, sqlda))
ERREXIT(status, 1);
}
for ( i = 0, var = sqlda->sqlvar; i < sqlda->sqld; i++, var++ ) {
dtype = ( var->sqltype & ~1 );
switch ( dtype ) {
case SQL_VARYING:
var->sqltype = SQL_TEXT;
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_TEXT:
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen + 2 );
break;
case SQL_LONG:
var->sqltype = SQL_LONG;
var->sqldata = ( char * ) malloc( sizeof ( long ) );
break;
default:
var->sqldata = ( char * ) malloc( sizeof ( char ) * var->sqllen );
break;
}
if ( var->sqltype & 1 ) {
var->sqlind = ( short * ) malloc( sizeof ( short ) );
}
}
if ( !sqlda->sqld ) {
// Execute and commit non-select querys
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, NULL ) )
ERREXIT(status, 1);
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
trans = NULL;
} else {
if ( isc_dsql_execute ( status, &trans, &stmt, dialect, sqlda ) )
ERREXIT(status, 1);
}
return 1;
}
int fetch( void )
{
long fetch_stat;
long status[20];
fetch_stat = isc_dsql_fetch(status, &stmt, dialect, sqlda);
if (fetch_stat != 100L)
ERREXIT(status, 1);
return fetch_stat;
}
int qclose( void )
{
long status[20];
if (isc_dsql_free_statement(status, &stmt, DSQL_drop))
ERREXIT(status, 1);
if (trans)
if (isc_commit_transaction(status, &trans))
ERREXIT(status, 1);
if ( sqlda )
free( sqlda );
return 1;
}
char *getdata(int pos)
{
short dtype;
char data[MAX_BUFFER], *p;
char blob_s[20], date_s[25];
short len;
long status[20];
struct tm times;
ISC_QUAD bid;
XSQLVAR *var;
if ( ( pos + 1 ) > sqlda->sqln )
return "error";
var = sqlda->sqlvar;
var += pos;
dtype = var->sqltype & ~1;
p = data;
if ( ( var->sqltype & 1 ) && ( *var->sqlind < 0 ) ) {
switch ( dtype ) {
case SQL_TEXT:
case SQL_VARYING:
len = var->sqllen;
break;
case SQL_SHORT:
len = 6;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_LONG:
len = 11;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_INT64:
len = 21;
if ( var->sqlscale > 0 )
len += var->sqlscale;
break;
case SQL_FLOAT:
len = 15;
break;
case SQL_DOUBLE:
len = 24;
break;
case SQL_TIMESTAMP:
len = 24;
break;
case SQL_TYPE_DATE:
len = 10;
break;
case SQL_TYPE_TIME:
len = 13;
break;
case SQL_BLOB:
case SQL_ARRAY:
default:
len = 17;
break;
}
if ( ( dtype == SQL_TEXT ) || ( dtype == SQL_VARYING ) )
sprintf ( p, "%-*s ", len, "NULL" );
else
sprintf ( p, "%*s ", len, "NULL" );
} else {
switch ( dtype ) {
case SQL_TEXT:
sprintf ( p, "%.*s ", var->sqllen, var->sqldata );
break;
case SQL_VARYING:
sprintf ( p, "%.*s ", var->sqllen, var->sqldata );
break;
case SQL_SHORT:
case SQL_LONG:
case SQL_INT64:
{
ISC_INT64 value = 0;
short field_width = 0;
short dscale;
switch ( dtype ) {
case SQL_SHORT:
value = ( ISC_INT64 ) * ( short ISC_FAR * ) var->sqldata;
field_width = 6;
break;
case SQL_LONG:
value = ( ISC_INT64 ) * ( long ISC_FAR * ) var->sqldata;
field_width = 11;
break;
case SQL_INT64:
value = ( ISC_INT64 ) * ( ISC_INT64 ISC_FAR * ) var->sqldata;
field_width = 21;
break;
}
dscale = var->sqlscale;
if ( dscale < 0 ) {
ISC_INT64 tens;
short i;
tens = 1;
for ( i = 0; i > dscale; i-- ) {
tens *= 10;
if ( value >= 0 ) {
sprintf ( p,
"%*" ISC_INT64_FORMAT "d.%0*"
ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
( ISC_INT64 ) ( value / tens ), -dscale,
( ISC_INT64 ) ( value % tens ) );
} else if ( ( value / tens ) != 0 ) {
sprintf ( p,
"%*" ISC_INT64_FORMAT "d.%0*"
ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
( ISC_INT64 ) ( value / tens ), -dscale,
( ISC_INT64 ) - ( value % tens ) );
} else {
sprintf ( p, "%*s.%0*" ISC_INT64_FORMAT "d",
field_width - 1 + dscale,
"-0", -dscale,
( ISC_INT64 ) - ( value % tens ) );
}
}
} else if ( dscale ) {
sprintf ( p, "%*" ISC_INT64_FORMAT "d%0*d",
field_width, ( ISC_INT64 ) value, dscale, 0 );
} else {
sprintf ( p, "%*" ISC_INT64_FORMAT "d",
field_width, ( ISC_INT64 ) value );
}
};
break;
case SQL_FLOAT:
sprintf ( p, "%15g ", *( float ISC_FAR * ) ( var->sqldata ) );
break;
case SQL_DOUBLE:
sprintf ( p, "%24f ", *( double ISC_FAR * ) ( var->sqldata ) );
break;
case SQL_TIMESTAMP:
isc_decode_timestamp ( ( ISC_TIMESTAMP ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d %02d:%02d:%02d.%04lui",
times.tm_year + 1900,
times.tm_mon + 1,
times.tm_mday,
times.tm_hour,
times.tm_min,
times.tm_sec,
( ( ISC_TIMESTAMP * ) var->sqldata )->timestamp_time % 10000 );
sprintf ( p, "%*s ", 24, date_s );
break;
case SQL_TYPE_DATE:
isc_decode_sql_date ( ( ISC_DATE ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%04d-%02d-%02d",
times.tm_year + 1900, times.tm_mon + 1, times.tm_mday );
sprintf ( p, "%*s ", 10, date_s );
break;
case SQL_TYPE_TIME:
isc_decode_sql_time ( ( ISC_TIME ISC_FAR * ) var->sqldata, &times );
sprintf ( date_s, "%02d:%02d:%02d.%04lui",
times.tm_hour,
times.tm_min,
times.tm_sec, ( *( ( ISC_TIME * ) var->sqldata ) ) % 10000 );
sprintf ( p, "%*s ", 13, date_s );
break;
case SQL_BLOB:
case SQL_ARRAY:
/* Print the blob id on blobs or arrays */
bid = *( ISC_QUAD ISC_FAR * ) var->sqldata;
sprintf ( blob_s, "%08x:%08x", ( unsigned int ) bid.gds_quad_high,
( unsigned int ) bid.gds_quad_low );
sprintf ( p, "%17s ", blob_s );
break;
default:
break;
}
}
return ( p );
}

1063
harbour/contrib/firebird/tfirebird.prg Normal file
View File

File diff suppressed because it is too large Load Diff

2
harbour/contrib/hbzlib/make_b32.bat
View File

@@ -19,7 +19,7 @@ if "%HB_CC_NAME%" == "" set HB_CC_NAME=b32
if "%HB_MAKE_PROGRAM%" == "" set HB_MAKE_PROGRAM=make.exe
set HB_MAKEFILE=..\mtpl_%HB_CC_NAME%.mak
set C_USR=-Iinclude -DZLIB_DLL;WIN32;ASSERT -vi -Ve -6 -R- -H- -5 -OS -w- -X- -a8 -b -k-
set C_USR=%C_USR% -Iinclude -DZLIB_DLL;WIN32;ASSERT -vi -Ve -6 -R- -H- -5 -OS -w- -X- -a8 -b -k-
rem ---------------------------------------------------------------

2
harbour/contrib/hbzlib/make_vc.bat
View File

@@ -19,7 +19,7 @@ if "%HB_CC_NAME%" == "" set HB_CC_NAME=vc
if "%HB_MAKE_PROGRAM%" == "" set HB_MAKE_PROGRAM=nmake.exe
set HB_MAKEFILE=..\mtpl_%HB_CC_NAME%.mak
set C_USR=-Iinclude -DZLIB_DLL;WIN32;ASSERT
set C_USR=%C_USR% -Iinclude -DZLIB_DLL;WIN32;ASSERT
rem ---------------------------------------------------------------

0
harbour/contrib/mysql/test.prg → harbour/contrib/mysql/test/test.prg
View File