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

2008-10-21 08:29 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
+ contrib/rddsql
  + contrib/rddsql/common.mak
  + contrib/rddsql/tests
  + contrib/rddsql/tests/test1.prg
  + contrib/rddsql/tests/bld_b32.bat
  + contrib/rddsql/tests/bld_vc.bat
  + contrib/rddsql/Makefile
  + contrib/rddsql/make_b32.bat
  + contrib/rddsql/make_vc.bat
  + contrib/rddsql/make_gcc.sh
  + contrib/rddsql/mysqldd.c
  + contrib/rddsql/sqlbase.c
  + contrib/rddsql/sqlmix.c
  + contrib/rddsql/hbsqldd.h
    + Added SQL RDD sent to the list by Mindaugas.
    * Changed strcpy(), unused vars, startup code, 
      added make files, fixed all MSVS/BCC warnings, 
      other minor cleanups.
    * Changed 'BYTE val[]' to 'BYTE * val' in struct decl.
    ; TOFIX: It doesn't compile on MSVC due to this error:
             .\mysqldd.c(65) : fatal error C1017: invalid integer constant expression

  * ChangeLog
    + Marked one change as TOMERGE.

  * contrib/hbdbgfx/dbgfxc.c
    * Minor cleanup.

  * source/vm/harbinit.prg
    * Minor.

  * source/rtl/xhelp.c
    ! Typo in comment.

  * source/rtl/valtoexp.prg
  * source/rtl/alert.prg
    * {|| ... } -> {||...} for consistency along Harbour.
This commit is contained in:
Viktor Szakats
2008-10-21 06:43:47 +00:00
parent 8b8b86a386
commit ad8389d113
18 changed files with 4797 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
harbour/ChangeLog
View File

@@ -8,6 +8,45 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2008-10-21 08:29 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
+ contrib/rddsql
+ contrib/rddsql/common.mak
+ contrib/rddsql/tests
+ contrib/rddsql/tests/test1.prg
+ contrib/rddsql/tests/bld_b32.bat
+ contrib/rddsql/tests/bld_vc.bat
+ contrib/rddsql/Makefile
+ contrib/rddsql/make_b32.bat
+ contrib/rddsql/make_vc.bat
+ contrib/rddsql/make_gcc.sh
+ contrib/rddsql/mysqldd.c
+ contrib/rddsql/sqlbase.c
+ contrib/rddsql/sqlmix.c
+ contrib/rddsql/hbsqldd.h
+ Added SQL RDD sent to the list by Mindaugas.
* Changed strcpy(), unused vars, startup code,
added make files, fixed all MSVS/BCC warnings,
other minor cleanups.
* Changed 'BYTE val[]' to 'BYTE * val' in struct decl.
; TOFIX: It doesn't compile on MSVC due to this error:
.\mysqldd.c(65) : fatal error C1017: invalid integer constant expression
* ChangeLog
+ Marked one change as TOMERGE.
* contrib/hbdbgfx/dbgfxc.c
* Minor cleanup.
* source/vm/harbinit.prg
* Minor.
* source/rtl/xhelp.c
! Typo in comment.
* source/rtl/valtoexp.prg
* source/rtl/alert.prg
* {|| ... } -> {||...} for consistency along Harbour.
2008-10-21 02:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/common.mak
* harbour/source/lang/Makefile
@@ -66,6 +105,7 @@
2008-10-20 01:18 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/hbstack.h
! added HB_EXPORT to hb_stack*() functions used in -gc3 code
[TOMERGE 1.0]
2008-10-20 00:25 UTC+0200 Francesco Saverio Giudice (info fsgiudice com)
* contrib/hbdbgfx

4
harbour/contrib/hbdbgfx/dbgfxc.c
View File

@@ -103,10 +103,10 @@ HB_EXPORT BOOL hb_EmptyLogFile( BOOL bOnOff )
HB_EXPORT void hb_ToLogFile( const char * sFile, const char * sTraceMsg, ... )
{
FILE * hFile;
if( s_bToLogFile )
{
FILE * hFile;
if( sFile == NULL )
{
if( s_bEmptyLogFile )

28
harbour/contrib/rddsql/Makefile Normal file
View File

@@ -0,0 +1,28 @@
#
# $Id$
#
ROOT = ../../
LIBNAME=rddsql
ifeq ($(HB_INC_MYSQL),)
ifeq ($(HB_XBUILD),)
HB_INC_MYSQL = /usr/include/mysql
endif
endif
HB_INC_MYSQL_OK += $(foreach d, $(HB_INC_MYSQL), $(if $(wildcard $(d)/mysql.h),$(d),))
ifneq ($(strip $(HB_INC_MYSQL_OK)),)
C_USR += $(foreach d, $(HB_INC_MYSQL_OK), -I$(d))
C_SOURCES=\
mysqldd.c \
sqlbase.c \
sqlmix.c \
else
include $(TOP)$(ROOT)config/none.cf
endif

15
harbour/contrib/rddsql/common.mak Normal file
View File

@@ -0,0 +1,15 @@
#
# $Id$
#
LIBNAME = $(LIBPREF)rddsql
LIB_PATH = $(LIB_DIR)$(LIBNAME)$(LIBEXT)
LIB_OBJS = \
$(OBJ_DIR)mysqldd$(OBJEXT) \
$(OBJ_DIR)sqlbase$(OBJEXT) \
$(OBJ_DIR)sqlmix$(OBJEXT) \
all: \
$(LIB_PATH) \

352
harbour/contrib/rddsql/hbsqldd.h Normal file
View File

@@ -0,0 +1,352 @@
/*
* $Id$
*/
/*
* SQL Database Driver include file
*
* Copyright 2007 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
* www - http://www.harbour-project.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.
*
*/
#ifndef HBSQLDD_H_
#define HBSQLDD_H_
#include "hbapirdd.h"
#include "hbdbferr.h"
#include "hbapierr.h"
#include "hbapilng.h"
#include "hbapi.h"
// New ...INFO_ constants
#define DBI_QUERY 1001
#define RDDI_CONNECT 1001
#define RDDI_DISCONNECT 1002
#define RDDI_EXECUTE 1003
#define RDDI_ERROR 1004
#define RDDI_ERRORNO 1005
#define RDDI_NEWID 1006
#define RDDI_AFFECTEDROWS 1007
#define RDDI_QUERY 1008
//====================================================================
// SQLBASE
//====================================================================
#define MAX_FIELD_NAME 64
#define SQLDD_ROWSET_INIT 256
#define SQLDD_ROWSET_RESIZE 64
#define SQLDD_FLAG_DELETED 1
#define SQLDD_FLAG_CACHED 2
typedef struct _SQLBASEAREA
{
struct _RDDFUNCS * lprfsHost; /* Virtual method table for this workarea */
USHORT uiArea; /* The number assigned to this workarea */
void * atomAlias; /* Pointer to the alias symbol for this workarea */
USHORT uiFieldExtent; /* Total number of fields allocated */
USHORT uiFieldCount; /* Total number of fields used */
LPFIELD lpFields; /* Pointer to an array of fields */
void * lpFieldExtents; /* Void ptr for additional field properties */
PHB_ITEM valResult; /* All purpose result holder */
BOOL fTop; /* TRUE if "top" */
BOOL fBottom; /* TRUE if "bottom" */
BOOL fBof; /* TRUE if "bof" */
BOOL fEof; /* TRUE if "eof" */
BOOL fFound; /* TRUE if "found" */
DBSCOPEINFO dbsi; /* Info regarding last LOCATE */
DBFILTERINFO dbfi; /* Filter in effect */
LPDBORDERCONDINFO lpdbOrdCondInfo;
LPDBRELINFO lpdbRelations; /* Parent/Child relationships used */
USHORT uiParents; /* Number of parents for this area */
USHORT heap;
USHORT heapSize;
USHORT rddID;
USHORT uiMaxFieldNameLength;
PHB_CODEPAGE cdPage; /* Area's codepage pointer */
/*
* SQLBASE additions to the workarea structure
*/
LPDBRELINFO lpdbPendingRel;
ULONG ulConnection;
struct _SQLDDCONNECTION* pConnection;
struct _SDDNODE* pSDD;
char* szQuery; /* SQL query */
ULONG ulRecNo; /* Current record number */
ULONG ulRecCount; /* Total records */
ULONG ulRecMax; /* Size of pRow, pRowFlags buffer */
void** pRow; /* array of native pointers or cached PHB_ITEM */
BYTE* pRowFlags;
void* pRecord;
BYTE bRecordFlags;
void* pResult; /* SQL result */
void* pStmt; /* SQL statement */
void* pTrans; /* SQL transaction */
void* pNatRecord;
void* pNatLength;
BOOL fFetched;
BOOL fPositioned;
BOOL fAppend;
BOOL fRecordChanged;
} SQLBASEAREA, *SQLBASEAREAP;
typedef struct _SQLDDCONNECTION
{
struct _SDDNODE * pSDD;
void* hConnection;
int iError;
char* szError;
char* szQuery;
PHB_ITEM pNewID;
ULONG ulAffectedRows;
} SQLDDCONNECTION;
//====================================================================
// SQLMIX
//====================================================================
#define MIX_MAXKEYLEN 1024
#define MIX_MAXTAGNAMELEN 16
#define MIX_NODE_ORDER 2 // >=2
typedef struct _MIXKEY
{
ULONG rec;
BYTE notnul;
BYTE * val;
} MIXKEY, *PMIXKEY;
typedef struct _MIXNODE
{
UINT Leaf;
UINT KeyCount;
struct _MIXNODE* Parent;
struct _MIXNODE* Child[ MIX_NODE_ORDER + 1 ];
} MIXNODE, *PMIXNODE;
typedef struct _MIXNODELEAF
{
UINT Leaf;
UINT KeyCount;
struct _MIXNODE* Parent;
} MIXNODELEAF, *PMIXNODELEAF;
typedef struct _MIXTAG
{
struct _MIXTAG* pNext;
struct _SQLMIXAREA* pArea;
char* szName;
char* szKeyExpr;
char* szForExpr;
PHB_ITEM pKeyItem;
PHB_ITEM pForItem;
BYTE bType;
UINT uiKeyLen; // Length of key
UINT uiTotalLen; // Total length of key structure
BOOL fEof;
BOOL fBof;
BOOL fCustom;
PMIXNODE Root;
PMIXKEY CurKey;
PMIXNODE CurNode;
UINT CurPos;
PMIXKEY HotKey;
BOOL HotFor;
BYTE* pSortTable; // National sorttable for character key tags, NULL otherwise
} MIXTAG, *PMIXTAG;
typedef struct _SQLMIXAREA
{
struct _RDDFUNCS * lprfsHost; /* Virtual method table for this workarea */
USHORT uiArea; /* The number assigned to this workarea */
void * atomAlias; /* Pointer to the alias symbol for this workarea */
USHORT uiFieldExtent; /* Total number of fields allocated */
USHORT uiFieldCount; /* Total number of fields used */
LPFIELD lpFields; /* Pointer to an array of fields */
void * lpFieldExtents; /* Void ptr for additional field properties */
PHB_ITEM valResult; /* All purpose result holder */
BOOL fTop; /* TRUE if "top" */
BOOL fBottom; /* TRUE if "bottom" */
BOOL fBof; /* TRUE if "bof" */
BOOL fEof; /* TRUE if "eof" */
BOOL fFound; /* TRUE if "found" */
DBSCOPEINFO dbsi; /* Info regarding last LOCATE */
DBFILTERINFO dbfi; /* Filter in effect */
LPDBORDERCONDINFO lpdbOrdCondInfo;
LPDBRELINFO lpdbRelations; /* Parent/Child relationships used */
USHORT uiParents; /* Number of parents for this area */
USHORT heap;
USHORT heapSize;
USHORT rddID;
USHORT uiMaxFieldNameLength;
PHB_CODEPAGE cdPage; /* Area's codepage pointer */
/*
* SQLBASE additions to the workarea structure
*/
LPDBRELINFO lpdbPendingRel;
ULONG ulConnection;
struct _SQLDDCONNECTION* pConnection;
struct _SDDNODE* pSDD;
char* szQuery; /* SQL query */
ULONG ulRecNo; /* Current record number */
ULONG ulRecCount; /* Total records */
ULONG ulRecMax; /* Size of pRow, pRowFlags buffer */
void** pRow; /* array of native pointers or cached PHB_ITEM */
BYTE* pRowFlags;
void* pRecord;
BYTE bRecordFlags;
void* pResult; /* SQL result */
void* pStmt; /* SQL statement */
void* pTrans; /* SQL transaction */
void* pNatRecord;
void* pNatLength;
BOOL fFetched;
BOOL fPositioned;
BOOL fAppend;
BOOL fRecordChanged;
/*
* SQLMIX additions to the workarea structure
*/
PMIXTAG pTagList;
PMIXTAG pTag;
BYTE* pSortTable;
} SQLMIXAREA, *SQLMIXAREAP;
//====================================================================
// SQLDD
//====================================================================
typedef ERRCODE (* SDDFUNC_CONNECT )( SQLDDCONNECTION* pConnection, PHB_ITEM pItem );
typedef ERRCODE (* SDDFUNC_DISCONNECT )( SQLDDCONNECTION* pConnection );
typedef ERRCODE (* SDDFUNC_EXECUTE )( SQLDDCONNECTION* pConnection, PHB_ITEM pItem );
typedef ERRCODE (* SDDFUNC_OPEN )( SQLBASEAREAP pArea );
typedef ERRCODE (* SDDFUNC_CLOSE )( SQLBASEAREAP pArea );
typedef ERRCODE (* SDDFUNC_GOTO )( SQLBASEAREAP pArea, ULONG ulRecNo );
typedef ERRCODE (* SDDFUNC_GETVALUE )( SQLBASEAREAP pArea, USHORT uiIndex, PHB_ITEM pItem );
typedef ERRCODE (* SDDFUNC_GETVARLEN )( SQLBASEAREAP pArea, USHORT uiIndex, ULONG * pLength );
typedef struct _SDDNODE
{
struct _SDDNODE * pNext;
char* Name;
SDDFUNC_CONNECT Connect;
SDDFUNC_DISCONNECT Disconnect;
SDDFUNC_EXECUTE Execute;
SDDFUNC_OPEN Open;
SDDFUNC_CLOSE Close;
SDDFUNC_GOTO GoTo;
SDDFUNC_GETVALUE GetValue;
SDDFUNC_GETVARLEN GetVarLen;
} SDDNODE, * PSDDNODE;
int hb_sddRegister( PSDDNODE pSdd );
//====================================================================
// Misc
//====================================================================
// Error subcodes
#define ESQLDD_NOTCONNECTED 1901
#define ESQLDD_INVALIDFIELD 1902
#define ESQLDD_INVALIDQUERY 1903
#define ESQLDD_START 1904
#define ESQLDD_COMMIT 1905
#define ESQLDD_STMTALLOC 1906
#define ESQLDD_STMTDESCR 1907
#define ESQLDD_STMTFREE 1908
#define ESQLDD_FETCH 1909
#define ESQLDD_LOWMEMORY 1910
#endif

69
harbour/contrib/rddsql/make_b32.bat Normal file
View File

@@ -0,0 +1,69 @@
@echo off
rem
rem $Id$
rem
if not "%HB_INC_MYSQL%%HB_DIR_MYSQL%" == "" goto DIR_OK
echo ---------------------------------------------------------------
echo IMPORTANT: You'll need MySQL package and this envvar
echo to be set to successfully build this library:
echo set HB_INC_MYSQL=C:\mysql\include
echo or
echo set HB_DIR_MYSQL=C:\mysql
echo if you want to generate .lib for the .dll.
echo ---------------------------------------------------------------
goto POST_EXIT
:DIR_OK
if "%HB_INC_MYSQL%" == "" set HB_INC_MYSQL=%HB_DIR_MYSQL%\include
set CFLAGS=-I"%HB_INC_MYSQL%"
set _HB_DLL_NAME=libmySQL
set _HB_DLL_DIR=%HB_DIR_MYSQL%\bin
rem ---------------------------------------------------------------
call ..\mtpl_b32.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
rem ---------------------------------------------------------------
if "%HB_DIR_MYSQL%" == "" goto POST_EXIT
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
if "%1" == "clean" goto POST_CLEAN
if "%1" == "Clean" goto POST_CLEAN
if "%1" == "CLEAN" goto POST_CLEAN
if "%1" == "install" goto POST_INSTALL
if "%1" == "Install" goto POST_INSTALL
if "%1" == "INSTALL" goto POST_INSTALL
:POST_BUILD
implib ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib "%_HB_DLL_DIR%\%_HB_DLL_NAME%.dll" >> %_HB_MAKELOG%
goto POST_EXIT
:POST_CLEAN
if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib > nul
if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.exp del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.exp > nul
if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib > nul
goto POST_EXIT
:POST_INSTALL
if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib
if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib copy ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib %_HB_LIB_INSTALL%
goto POST_EXIT
:POST_EXIT
set CFLAGS=
set _HB_DLL_NAME=
set _HB_DLL_DIR=
set _HB_INSTALL_PREFIX=
set _HB_LIB_INSTALL=

24
harbour/contrib/rddsql/make_gcc.sh Executable file
View File

@@ -0,0 +1,24 @@
#!/bin/sh
#
# $Id$
#
if [ "${HB_INC_MYSQL}" = "" ]
then
echo "---------------------------------------------------------------"
echo "IMPORTANT: You will need MYSQL package installed and this"
echo " envvar to be set to successfully build this library:"
echo " export HB_INC_MYSQL=C:/Mysql/include"
echo " or"
echo " export HB_INC_MYSQL=/usr/include/mysql"
echo "---------------------------------------------------------------"
exit 1
fi
export CFLAGS=""
for I in ${HB_INC_MYSQL}; do
CFLAGS="${CFLAGS} -I${I}"
done
../mtpl_gcc.sh $1 $2 $3 $4 $5 $6 $7 $8 $9
unset CFLAGS

70
harbour/contrib/rddsql/make_vc.bat Normal file
View File

@@ -0,0 +1,70 @@
@echo off
rem
rem $Id$
rem
if not "%HB_INC_MYSQL%%HB_DIR_MYSQL%" == "" goto DIR_OK
echo ---------------------------------------------------------------
echo IMPORTANT: You'll need MySQL package and this envvar
echo to be set to successfully build this library:
echo set HB_INC_MYSQL=C:\mysql\include
echo or
echo set HB_DIR_MYSQL=C:\mysql
echo if you want to generate .lib for the .dll.
echo ---------------------------------------------------------------
goto POST_EXIT
:DIR_OK
if "%HB_INC_MYSQL%" == "" set HB_INC_MYSQL=%HB_DIR_MYSQL%\include
set CFLAGS=-I"%HB_INC_MYSQL%"
set _HB_DLL_NAME=libmySQL
set _HB_DLL_DIR=%HB_DIR_MYSQL%\bin
rem ---------------------------------------------------------------
call ..\mtpl_vc.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
rem ---------------------------------------------------------------
if "%HB_DIR_MYSQL%" == "" goto POST_EXIT
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
if "%1" == "clean" goto POST_CLEAN
if "%1" == "Clean" goto POST_CLEAN
if "%1" == "CLEAN" goto POST_CLEAN
if "%1" == "install" goto POST_INSTALL
if "%1" == "Install" goto POST_INSTALL
if "%1" == "INSTALL" goto POST_INSTALL
:POST_BUILD
rem Use supplied .lib file.
if not exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib copy "%HB_DIR_MYSQL%\lib\opt\%_HB_DLL_NAME%.lib" ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib > nul
goto POST_EXIT
:POST_CLEAN
if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib > nul
if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.exp del ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.exp > nul
if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib > nul
goto POST_EXIT
:POST_INSTALL
if exist %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib del %_HB_LIB_INSTALL%\%_HB_DLL_NAME%.lib
if exist ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib copy ..\..\lib\%_HB_CC_NAME%\%_HB_DLL_NAME%.lib %_HB_LIB_INSTALL%
goto POST_EXIT
:POST_EXIT
set CFLAGS=
set _HB_DLL_NAME=
set _HB_DLL_DIR=
set _HB_INSTALL_PREFIX=
set _HB_LIB_INSTALL=

603
harbour/contrib/rddsql/mysqldd.c Normal file
View File

@@ -0,0 +1,603 @@
/*
* $Id$
*/
/*
* MySQL Database Driver
*
* Copyright 2007 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
* www - http://www.harbour-project.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.
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbvm.h"
#include "hbsqldd.h"
#ifndef my_socket_defined
#define my_socket_defined
typedef int my_socket;
#endif
#include "mysql.h"
#if sizeof( MYSQL_ROW_OFFSET ) != sizeof( void* )
#error "MySQLDD error: sizeof( MYSQL_ROW_OFFSET ) != sizeof( void* )"
#endif
#if sizeof( MYSQL_ROW ) != sizeof( void* )
#error "MySQLDD error: sizeof( MYSQL_ROW ) != sizeof( void* )"
#endif
#ifndef MYSQL_TYPE_NEWDECIMAL
#define MYSQL_TYPE_NEWDECIMAL 246
#endif
static ERRCODE mysqlConnect( SQLDDCONNECTION* pConnection, PHB_ITEM pItem );
static ERRCODE mysqlDisconnect( SQLDDCONNECTION* pConnection );
static ERRCODE mysqlExecute( SQLDDCONNECTION* pConnection, PHB_ITEM pItem );
static ERRCODE mysqlOpen( SQLBASEAREAP pArea );
static ERRCODE mysqlClose( SQLBASEAREAP pArea );
static ERRCODE mysqlGoTo( SQLBASEAREAP pArea, ULONG ulRecNo );
static ERRCODE mysqlGetValue( SQLBASEAREAP pArea, USHORT uiIndex, PHB_ITEM pItem );
static ERRCODE mysqlGetVarLen( SQLBASEAREAP pArea, USHORT uiIndex, ULONG * pLength );
static SDDNODE mysqldd = {
NULL,
"MYSQL",
(SDDFUNC_CONNECT) mysqlConnect,
(SDDFUNC_DISCONNECT) mysqlDisconnect,
(SDDFUNC_EXECUTE) mysqlExecute,
(SDDFUNC_OPEN) mysqlOpen,
(SDDFUNC_CLOSE) mysqlClose,
(SDDFUNC_GOTO) mysqlGoTo,
(SDDFUNC_GETVALUE) mysqlGetValue,
(SDDFUNC_GETVARLEN) mysqlGetVarLen
};
HB_FUNC_EXTERN( SQLBASE );
static void hb_mysqldd_init( void * cargo )
{
HB_SYMBOL_UNUSED( cargo );
if ( ! hb_sddRegister( & mysqldd ) )
{
hb_errInternal( HB_EI_RDDINVALID, NULL, NULL, NULL );
HB_FUNC_EXEC( SQLBASE ); // force SQLBASE linking
}
}
#define __PRG_SOURCE__ __FILE__
#ifdef HB_PCODE_VER
#undef HB_PRG_PCODE_VER
#define HB_PRG_PCODE_VER HB_PCODE_VER
#endif
HB_FUNC( MYSQLDD ) {;}
HB_INIT_SYMBOLS_BEGIN( mysqldd__InitSymbols )
{ "MYSQLDD", HB_FS_PUBLIC, HB_FUNCNAME( MYSQLDD ), NULL },
HB_INIT_SYMBOLS_END( mysqldd__InitSymbols )
HB_CALL_ON_STARTUP_BEGIN( _hb_mysqldd_init_ )
hb_vmAtInit( hb_mysqldd_init, NULL );
HB_CALL_ON_STARTUP_END( _hb_mysqldd_init_ )
#if defined(HB_PRAGMA_STARTUP)
#pragma startup mysqldd__InitSymbols
#pragma startup _hb_mysqldd_init_
#elif defined(_MSC_VER)
#if _MSC_VER >= 1010
#pragma data_seg( ".CRT$XIY" )
#pragma comment( linker, "/Merge:.CRT=.data" )
#else
#pragma data_seg( "XIY" )
#endif
static HB_$INITSYM hb_vm_auto_mysqldd__InitSymbols = mysqldd__InitSymbols;
static HB_$INITSYM hb_vm_auto_mysqldd_init = _hb_mysqldd_init_;
#pragma data_seg()
#endif
//=====================================================================================
static USHORT hb_errRT_MySQLDD( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode )
{
USHORT uiAction;
PHB_ITEM pError;
pError = hb_errRT_New( ES_ERROR, "MYSQLDD", ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, EF_NONE );
uiAction = hb_errLaunch( pError );
hb_itemRelease( pError );
return uiAction;
}
//============= SDD METHODS =============================================================
static ERRCODE mysqlConnect( SQLDDCONNECTION* pConnection, PHB_ITEM pItem )
{
MYSQL* pMySql;
// TraceLog( NULL, "mysqlConnect type:%04X s2:%s s3:%s s4:%s s5:%s\n", pItem->type, hb_arrayGetCPtr( pItem, 2 ), hb_arrayGetCPtr( pItem, 3 ), hb_arrayGetCPtr( pItem, 4 ), hb_arrayGetCPtr( pItem, 5 ) );
pMySql = mysql_init( NULL );
if ( ! mysql_real_connect( pMySql, hb_arrayGetCPtr( pItem, 2 ), hb_arrayGetCPtr( pItem, 3 ), hb_arrayGetCPtr( pItem, 4 ),
hb_arrayGetCPtr( pItem, 5 ), 0 /* port */, NULL /* pipe */, 0 /* flags*/ ) )
{
mysql_close( pMySql );
return FAILURE;
}
pConnection->hConnection = (void*) pMySql;
return SUCCESS;
}
static ERRCODE mysqlDisconnect( SQLDDCONNECTION* pConnection )
{
mysql_close( pConnection->hConnection );
return SUCCESS;
}
static ERRCODE mysqlExecute( SQLDDCONNECTION* pConnection, PHB_ITEM pItem )
{
MYSQL_RES* pResult;
if ( mysql_real_query( (MYSQL*) pConnection->hConnection, hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) )
{
const char* szError;
pConnection->iError = (int) mysql_errno( (MYSQL*) pConnection->hConnection );
szError = mysql_error( (MYSQL*) pConnection->hConnection );
if ( pConnection->szError )
pConnection->szError = hb_xrealloc( pConnection->szError, strlen( szError ) + 1 );
else
pConnection->szError = hb_xgrab( strlen( szError ) + 1 );
hb_strncpy( pConnection->szError, szError, strlen( szError ) );
return FAILURE;
}
pResult = mysql_store_result( (MYSQL*) pConnection->hConnection );
if ( pResult )
{
pConnection->ulAffectedRows = (ULONG) mysql_num_rows( pResult );
mysql_free_result( pResult );
}
else
{
if ( mysql_field_count( (MYSQL*) pConnection->hConnection ) == 0 )
{
pConnection->ulAffectedRows = (ULONG) mysql_affected_rows( (MYSQL*) pConnection->hConnection );
if ( mysql_insert_id( (MYSQL*) pConnection->hConnection ) != 0 )
hb_itemPutNInt( pConnection->pNewID, mysql_insert_id( (MYSQL*) pConnection->hConnection ) );
}
else // error
{
const char* szError;
pConnection->iError = (int) mysql_errno( (MYSQL*) pConnection->hConnection );
szError = mysql_error( (MYSQL*) pConnection->hConnection );
if ( pConnection->szError )
pConnection->szError = hb_xrealloc( pConnection->szError, strlen( szError ) + 1 );
else
pConnection->szError = hb_xgrab( strlen( szError ) + 1 );
hb_strncpy( pConnection->szError, szError, strlen( szError ) );
return FAILURE;
}
}
return SUCCESS;
}
static ERRCODE mysqlOpen( SQLBASEAREAP pArea )
{
PHB_ITEM pItemEof, pItem;
ULONG ulIndex;
USHORT uiFields, uiCount, uiError = 0;
BOOL bError;
BYTE* pBuffer;
DBFIELDINFO pFieldInfo;
MYSQL_FIELD* pMyField;
void** pRow;
if ( mysql_real_query( (MYSQL*) pArea->pConnection->hConnection, pArea->szQuery, strlen( pArea->szQuery ) ) )
{
hb_errRT_MySQLDD( EG_OPEN, ESQLDD_INVALIDQUERY, (char*) mysql_error( (MYSQL*) pArea->pConnection->hConnection ), pArea->szQuery,
mysql_errno( (MYSQL*) pArea->pConnection->hConnection ) );
return FAILURE;
}
if ( ( pArea->pResult = mysql_store_result( (MYSQL*) pArea->pConnection->hConnection ) ) == NULL )
{
hb_errRT_MySQLDD( EG_MEM, ESQLDD_INVALIDQUERY, (char*) mysql_error( (MYSQL*) pArea->pConnection->hConnection ), pArea->szQuery,
mysql_errno( (MYSQL*) pArea->pConnection->hConnection ) );
return FAILURE;
}
// TODO: o kokiu atveju jau gali buti laukai? kaip tada su pItemEof priskyrimu?
if ( ! pArea->uiFieldCount )
{
uiFields = mysql_num_fields( (MYSQL_RES*) pArea->pResult );
SELF_SETFIELDEXTENT( (AREAP) pArea, uiFields );
pItemEof = hb_itemArrayNew( uiFields );
pBuffer = (BYTE*) hb_xgrab( 256 );
bError = FALSE;
for ( uiCount = 0; uiCount < uiFields; uiCount++ )
{
pMyField = mysql_fetch_field_direct( (MYSQL_RES*) pArea->pResult, uiCount );
hb_strncpy( pBuffer, pMyField->name, 256 - 1 );
pFieldInfo.atomName = pBuffer;
pFieldInfo.atomName[ MAX_FIELD_NAME ] = '\0';
hb_strUpper( (char *) pFieldInfo.atomName, MAX_FIELD_NAME + 1 );
pFieldInfo.uiLen = pMyField->length;
pFieldInfo.uiDec = 0;
switch( pMyField->type )
{
case MYSQL_TYPE_TINY:
case MYSQL_TYPE_SHORT:
pFieldInfo.uiType = HB_FT_INTEGER;
break;
case MYSQL_TYPE_LONG:
case MYSQL_TYPE_LONGLONG:
case MYSQL_TYPE_INT24:
pFieldInfo.uiType = HB_FT_LONG;
break;
case MYSQL_TYPE_DECIMAL:
case MYSQL_TYPE_NEWDECIMAL:
case MYSQL_TYPE_FLOAT:
case MYSQL_TYPE_DOUBLE:
pFieldInfo.uiType = HB_FT_DOUBLE;
pFieldInfo.uiDec = pMyField->decimals;
break;
case MYSQL_TYPE_STRING:
case MYSQL_TYPE_VAR_STRING:
case MYSQL_TYPE_ENUM:
case MYSQL_TYPE_DATETIME:
pFieldInfo.uiType = HB_FT_STRING;
break;
case MYSQL_TYPE_DATE:
pFieldInfo.uiType = HB_FT_DATE;
break;
case MYSQL_TYPE_TINY_BLOB:
case MYSQL_TYPE_MEDIUM_BLOB:
case MYSQL_TYPE_LONG_BLOB:
case MYSQL_TYPE_BLOB:
pFieldInfo.uiType = HB_FT_MEMO;
break;
// case MYSQL_TYPE_TIMESTAMP:
// case MYSQL_TYPE_TIME:
// case MYSQL_TYPE_DATETIME:
// case MYSQL_TYPE_YEAR:
// case MYSQL_TYPE_NEWDATE:
// case MYSQL_TYPE_ENUM:
// case MYSQL_TYPE_SET:
default:
bError = TRUE;
uiError = (USHORT) pMyField->type;
break;
}
if ( ! bError )
{
switch ( pFieldInfo.uiType )
{
case HB_FT_STRING:
{
char* pStr;
pStr = (char*) hb_xgrab( pFieldInfo.uiLen + 1 );
memset( pStr, ' ', pFieldInfo.uiLen );
pStr[ pFieldInfo.uiLen ] = '\0';
pItem = hb_itemPutCL( NULL, pStr, pFieldInfo.uiLen );
hb_xfree( pStr );
break;
}
case HB_FT_MEMO:
pItem = hb_itemPutC( NULL, "" );
break;
case HB_FT_INTEGER:
pItem = hb_itemPutNI( NULL, 0 );
break;
case HB_FT_LONG:
pItem = hb_itemPutNL( NULL, 0 );
break;
case HB_FT_DOUBLE:
pItem = hb_itemPutND( NULL, 0.0 );
break;
case HB_FT_DATE:
pItem = hb_itemPutDS( NULL, "" );
break;
default:
pItem = hb_itemNew( NULL );
bError = TRUE;
break;
}
hb_arraySetForward( pItemEof, uiCount + 1, pItem );
hb_itemRelease( pItem );
/* if ( pFieldInfo.uiType == HB_IT_DOUBLE || pFieldInfo.uiType == HB_IT_INTEGER )
{
pFieldInfo.uiType = HB_IT_LONG;
}*/
if ( ! bError )
bError = ( SELF_ADDFIELD( (AREAP) pArea, &pFieldInfo ) == FAILURE );
}
if ( bError )
break;
}
hb_xfree( pBuffer );
if ( bError )
{
hb_itemRelease( pItemEof );
hb_errRT_MySQLDD( EG_CORRUPTION, ESQLDD_INVALIDFIELD, "Invalid field type", pArea->szQuery, uiError );
return FAILURE;
}
}
pArea->ulRecCount = (ULONG) mysql_num_rows( (MYSQL_RES*) pArea->pResult );
pArea->pRow = (void**) hb_xgrab( ( pArea->ulRecCount + 1 ) * sizeof( void* ) );
pArea->pRowFlags = (BYTE*) hb_xgrab( ( pArea->ulRecCount + 1 ) * sizeof( BYTE ) );
memset( pArea->pRowFlags, 0, ( pArea->ulRecCount + 1 ) * sizeof( BYTE ) );
pArea->ulRecMax = pArea->ulRecCount + 1;
pRow = pArea->pRow;
*pRow = pItemEof;
pArea->pRowFlags[ 0 ] = SQLDD_FLAG_CACHED;
pRow++;
for ( ulIndex = 1; ulIndex <= pArea->ulRecCount; ulIndex++ )
{
*pRow++ = (void*) mysql_row_tell( (MYSQL_RES*) pArea->pResult );
mysql_fetch_row( (MYSQL_RES*) pArea->pResult );
}
pArea->fFetched = 1;
return SUCCESS;
}
static ERRCODE mysqlClose( SQLBASEAREAP pArea )
{
if ( pArea->pResult )
mysql_free_result( (MYSQL_RES*) pArea->pResult );
return SUCCESS;
}
static ERRCODE mysqlGoTo( SQLBASEAREAP pArea, ULONG ulRecNo )
{
if ( ulRecNo <= 0 || ulRecNo > pArea->ulRecCount )
{
pArea->pRecord = pArea->pRow[ 0 ];
pArea->bRecordFlags = pArea->pRowFlags[ 0 ];
pArea->fPositioned = FALSE;
}
else
{
pArea->pRecord = pArea->pRow[ ulRecNo ];
pArea->bRecordFlags = pArea->pRowFlags[ ulRecNo ];
if ( ! ( pArea->bRecordFlags & SQLDD_FLAG_CACHED ) )
{
mysql_row_seek( (MYSQL_RES*) pArea->pResult, pArea->pRecord );
pArea->pNatRecord = (void*) mysql_fetch_row( (MYSQL_RES*) pArea->pResult );
pArea->pNatLength = (void*) mysql_fetch_lengths( (MYSQL_RES*) pArea->pResult );
}
pArea->fPositioned = TRUE;
}
return SUCCESS;
}
static ERRCODE mysqlGetValue( SQLBASEAREAP pArea, USHORT uiIndex, PHB_ITEM pItem )
{
LPFIELD pField;
char* pValue;
char szBuffer[ 64 ];
BOOL bError;
PHB_ITEM pError;
ULONG ulLen;
bError = FALSE;
uiIndex--;
pField = pArea->lpFields + uiIndex;
pValue = ( (MYSQL_ROW) ( pArea->pNatRecord ) ) [ uiIndex ];
ulLen = ( (unsigned long*) ( pArea->pNatLength ) ) [ uiIndex ];
// NULL => NIL (?)
if ( ! pValue )
{
hb_itemClear( pItem );
return SUCCESS;
}
switch( pField->uiType )
{
case HB_FT_STRING:
{
#if 0
char* pStr;
// Do NOT trim strings
pStr = (char*) hb_xgrab( pField->uiLen + 1 );
if ( pValue )
memcpy( pStr, pValue, ulLen );
if ( (ULONG)pField->uiLen > ulLen )
memset( pStr + ulLen, ' ', pField->uiLen - ulLen );
pStr[ pField->uiLen ] = '\0';
hb_itemPutCRaw( pItem, pStr, pField->uiLen );
#else
// Trim strings
if ( pValue )
hb_itemPutCL( pItem, pValue, ulLen );
else
hb_itemPutCL( pItem, "", 0 );
#endif
break;
}
case HB_FT_MEMO:
if ( pValue )
hb_itemPutCL( pItem, pValue, ulLen );
else
hb_itemPutCL( pItem, "", 0 );
hb_itemSetCMemo( pItem );
break;
case HB_FT_INTEGER:
case HB_FT_LONG:
case HB_FT_DOUBLE:
if ( pValue )
{
hb_strncpy( szBuffer, pValue, sizeof( szBuffer ) - 1 );
if ( pField->uiDec )
{
hb_itemPutNDLen( pItem, atof( szBuffer ),
(int) pField->uiLen - ( (int) pField->uiDec + 1 ),
(int) pField->uiDec );
}
else
hb_itemPutNLLen( pItem, atol( szBuffer ), (int) pField->uiLen );
}
else
{
if ( pField->uiDec )
hb_itemPutNDLen( pItem, 0.0,
(int) pField->uiLen - ( (int) pField->uiDec + 1 ),
(int) pField->uiDec );
else
hb_itemPutNLLen( pItem, 0, (int) pField->uiLen );
}
break;
case HB_FT_DATE:
{
char szDate[ 9 ];
szDate[ 0 ] = pValue[ 0 ];
szDate[ 1 ] = pValue[ 1 ];
szDate[ 2 ] = pValue[ 2 ];
szDate[ 3 ] = pValue[ 3 ];
szDate[ 4 ] = pValue[ 5 ];
szDate[ 5 ] = pValue[ 6 ];
szDate[ 6 ] = pValue[ 8 ];
szDate[ 7 ] = pValue[ 9 ];
szDate[ 8 ] = '\0';
hb_itemPutDS( pItem, szDate );
break;
}
default:
bError = TRUE;
break;
}
if ( bError )
{
pError = hb_errNew();
hb_errPutGenCode( pError, EG_DATATYPE );
hb_errPutDescription( pError, hb_langDGetErrorDesc( EG_DATATYPE ) );
hb_errPutSubCode( pError, EDBF_DATATYPE );
SELF_ERROR( ( AREAP ) pArea, pError );
hb_itemRelease( pError );
return FAILURE;
}
return SUCCESS;
}
static ERRCODE mysqlGetVarLen( SQLBASEAREAP pArea, USHORT uiIndex, ULONG * pLength )
{
HB_SYMBOL_UNUSED( pArea );
HB_SYMBOL_UNUSED( uiIndex );
HB_SYMBOL_UNUSED( pLength );
return SUCCESS;
}

1154
harbour/contrib/rddsql/sqlbase.c Normal file
View File

File diff suppressed because it is too large Load Diff

2350
harbour/contrib/rddsql/sqlmix.c Normal file
View File

File diff suppressed because it is too large Load Diff

14
harbour/contrib/rddsql/tests/bld_b32.bat Normal file
View File

@@ -0,0 +1,14 @@
@echo off
rem
rem $Id$
rem
if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\..\..\bin
if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\..\..\lib
if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\..\..\include
set HB_ARCHITECTURE=w32
set HB_COMPILER=bcc32
set HB_USER_LIBS=rddsql.lib
call %HB_BIN_INSTALL%\hbmk.bat %1 %2 %3 %4 %5 %6 %7 %8 %9

14
harbour/contrib/rddsql/tests/bld_vc.bat Normal file
View File

@@ -0,0 +1,14 @@
@echo off
rem
rem $Id$
rem
if "%HB_BIN_INSTALL%" == "" set HB_BIN_INSTALL=..\..\..\bin
if "%HB_LIB_INSTALL%" == "" set HB_LIB_INSTALL=..\..\..\lib
if "%HB_INC_INSTALL%" == "" set HB_INC_INSTALL=..\..\..\include
set HB_ARCHITECTURE=w32
set HB_COMPILER=msvc
set HB_USER_LIBS=rddsql.lib
call %HB_BIN_INSTALL%\hbmk.bat %1 %2 %3 %4 %5 %6 %7 %8 %9

56
harbour/contrib/rddsql/tests/test1.prg Normal file
View File

@@ -0,0 +1,56 @@
/*
* $Id$
*/
#include "dbinfo.ch"
#include "error.ch"
#define DBI_QUERY 1001
#define RDDI_CONNECT 1001
#define RDDI_DISCONNECT 1002
#define RDDI_EXECUTE 1003
#define RDDI_ERROR 1004
#define RDDI_ERRORNO 1005
#define RDDI_NEWID 1006
#define RDDI_AFFECTEDROWS 1007
#define RDDI_QUERY 1008
REQUEST MYSQLDD, SQLMIX
FIELD RESIDENTS
PROC main()
LOCAL hConn
RDDSETDEFAULT("SQLMIX")
AEVAL(RDDLIST(), {|X| QOUT(X)})
IF RDDINFO(RDDI_CONNECT, {"MYSQL", "localhost", "test",, "test"}) == 0
? "Unable connect to the server"
RETURN
ENDIF
CreateTable()
? "Let's browse table (press any key)"
INKEY(0)
DBUSEAREA( .T.,, "SELECT * FROM country", "country" )
Browse()
? "Let's browse table ordered by resident count (press any key)"
INKEY(0)
INDEX ON RESIDENTS TAG residents TO country
Browse()
DBCLOSEALL()
RETURN
STATIC PROC CreateTable()
? RDDINFO(RDDI_EXECUTE, "DROP TABLE country")
? RDDINFO(RDDI_EXECUTE, "CREATE TABLE country (CODE char(3), NAME char(50), RESIDENTS int(11))")
? RDDINFO(RDDI_EXECUTE, "INSERT INTO country values ('LTU', 'Lithuania', 3369600), ('USA', 'United States of America', 305397000), ('POR', 'Portugal', 10617600), ('POL', 'Poland', 38115967), ('AUS', 'Australia', 21446187), ('FRA', 'France', 64473140), ('RUS', 'Russia', 141900000)")
RETURN
PROC RDDSYS(); RETURN

2
harbour/source/rtl/alert.prg
View File

@@ -92,7 +92,7 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay )
CASE hb_isLogical( xMessage ) ; cMessage := iif( xMessage, ".T.", ".F." )
CASE hb_isObject( xMessage ) ; cMessage := xMessage:className + " Object"
CASE hb_isSymbol( xMessage ) ; cMessage := "@" + xMessage:Name + "()"
CASE hb_isBlock( xMessage ) ; cMessage := "{|| ... }"
CASE hb_isBlock( xMessage ) ; cMessage := "{||...}"
OTHERWISE ; cMessage := "NIL"
ENDCASE

2
harbour/source/rtl/valtoexp.prg
View File

@@ -123,7 +123,7 @@ FUNCTION hb_CStr( xVal )
CASE "S"
RETURN "@" + xVal:name + "()"
CASE "B"
RETURN "{|| ... }"
RETURN "{||...}"
CASE "O"
RETURN "{ " + xVal:className + " Object }"
CASE "A"

4
harbour/source/rtl/xhelp.c
View File

@@ -63,7 +63,7 @@ HB_FUNC( __XHELP )
if( hb_dynsymIsFunction( s_pDynSym ) )
{
/* awhite: push the existing params after the dyn symbol */
/* NOTE: push the existing params after the dyn symbol. [awhite] */
USHORT uiPCount = ( USHORT ) hb_pcount();
USHORT uiParam;
@@ -71,7 +71,7 @@ HB_FUNC( __XHELP )
hb_vmPushDynSym( s_pDynSym );
hb_vmPushNil();
/* CA-Cl*pper respects references so hb_stackItemFromBase() is
* used insted of hb_param() [druzus]
* used instead of hb_param() [druzus]
*/
for( uiParam = 1; uiParam <= uiPCount; uiParam++ )
hb_vmPush( hb_stackItemFromBase( uiParam ) );

4
harbour/source/vm/harbinit.prg
View File

@@ -52,7 +52,7 @@
#include "inkey.ch"
ANNOUNCE SysInit
ANNOUNCE SYSINIT
/* NOTE: For complete compatibility */
PROCEDURE CLIPPER520()
@@ -72,7 +72,7 @@ PROCEDURE CLIPPER530()
* explicitly in VM initialization process before hb_vmDoInitFunctions()
* and not depends on INIT clause.
*/
PROCEDURE ClipInit
PROCEDURE ClipInit()
MEMVAR GetList