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

2010-10-27 18:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/src/rdd/dbcmd.c
    * modified FIELDGET() and FIELDPUT() to accept
      also field name (not only field index)
      just like DBFILEGET() and DBFILEPUT()
    * modified HB_FIELDLEN(), HB_FIELDDEC(), HB_FIELDTYPE() to accept
      also field name (not only field index)

  * harbour/contrib/hbfship/hbfship.hbp
  + harbour/contrib/hbfship/fldarr.prg
  + harbour/contrib/hbfship/isdb.prg
  + harbour/contrib/hbfship/isfunc.c
  + harbour/contrib/hbfship/isbegseq.c
  + harbour/contrib/hbfship/flddeci.c
    + added FlagShip compatible functions:
         FieldGetArr( [ <nRecNo> ] ) -> <aFieldValues>
         FieldPutArr( <aFieldValues> [, <nRecNo> ] ) -> <lSuccess>
         IsDbExcl() -> <lExclusive>
         IsDbFlock() -> <lFLocked>
         IsDbRLock( [ <xRec> ] ) -> <lLocked>
         IsFunction( <cName> ) -> <lExists>
         IsBegSeq() -> <lResult>
         FieldDeci( <cFieldName> | <nFieldPos> ) -> <nDecimals>

  * harbour/contrib/hbwin/axcore.c
    * minor cleanup - replaced some 0 values with S_OK macro
This commit is contained in:
Przemyslaw Czerpak
2010-10-27 16:30:54 +00:00
parent 0f4730b0dd
commit 00cc4427ea
9 changed files with 427 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
harbour/ChangeLog
View File

@@ -16,6 +16,33 @@
The license applies to all entries newer than 2009-04-28.
*/
2010-10-27 18:30 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/src/rdd/dbcmd.c
* modified FIELDGET() and FIELDPUT() to accept
also field name (not only field index)
just like DBFILEGET() and DBFILEPUT()
* modified HB_FIELDLEN(), HB_FIELDDEC(), HB_FIELDTYPE() to accept
also field name (not only field index)
* harbour/contrib/hbfship/hbfship.hbp
+ harbour/contrib/hbfship/fldarr.prg
+ harbour/contrib/hbfship/isdb.prg
+ harbour/contrib/hbfship/isfunc.c
+ harbour/contrib/hbfship/isbegseq.c
+ harbour/contrib/hbfship/flddeci.c
+ added FlagShip compatible functions:
FieldGetArr( [ <nRecNo> ] ) -> <aFieldValues>
FieldPutArr( <aFieldValues> [, <nRecNo> ] ) -> <lSuccess>
IsDbExcl() -> <lExclusive>
IsDbFlock() -> <lFLocked>
IsDbRLock( [ <xRec> ] ) -> <lLocked>
IsFunction( <cName> ) -> <lExists>
IsBegSeq() -> <lResult>
FieldDeci( <cFieldName> | <nFieldPos> ) -> <nDecimals>
* harbour/contrib/hbwin/axcore.c
* minor cleanup - replaced some 0 values with S_OK macro
2010-10-27 17:45 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbqt/tests/demoqt.prg
* contrib/hbqt/tests/dialogqt.prg

98
harbour/contrib/hbfship/fldarr.prg Normal file
View File

@@ -0,0 +1,98 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* FieldGetArr() and FieldPutArr() FlagShip compatible function
*
* Copyright 2010 Przemyslaw Czerpak <druzus@acn.waw.pl>
* www - http://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.
*
*/
FUNCTION FieldGetArr( xRecNo )
LOCAL xPrevRec
LOCAL aFields
LOCAL nFields, n
IF xRecNo != NIL
xPrevRec := recNo()
dbGoTo( xRecNo )
ENDIF
nFields := FCount()
aFields := Array( nFields )
FOR n := 1 TO nFields
aFields[ n ] := FieldGet( n )
NEXT
IF xPrevRec != NIL
dbGoTo( xPrevRec )
ENDIF
RETURN aFields
FUNCTION FieldPutArr( aFields, xRecNo )
LOCAL xPrevRec
LOCAL nFields, n
IF xRecNo != NIL
xPrevRec := recNo()
dbGoTo( xRecNo )
ENDIF
nFields := FCount()
IF nFields > Len( aFields )
nFields := Len( aFields )
ENDIF
FOR n := 1 TO nFields
IF aFields[ n ] != NIL
FieldPut( n, aFields[ n ] )
ENDIF
NEXT
IF xPrevRec != NIL
dbGoTo( xPrevRec )
ENDIF
RETURN .T.

60
harbour/contrib/hbfship/flddeci.c Normal file
View File

@@ -0,0 +1,60 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* FIELDDECI() FlagShip compatible function
*
* Copyright 2010 Przemyslaw Czerpak <druzus@acn.waw.pl>
* www - http://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"
HB_FUNC_EXTERN( HB_FIELDDEC );
HB_FUNC( FIELDDECI )
{
HB_FUNC_EXEC( HB_FIELDDEC );
}

6
harbour/contrib/hbfship/hbfship.hbp
View File

@@ -9,5 +9,11 @@
-w3 -es2
fldarr.prg
isdb.prg
flddeci.c
isbegseq.c
isfunc.c
secondfs.c
strpeek.c

64
harbour/contrib/hbfship/isbegseq.c Normal file
View File

@@ -0,0 +1,64 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* IsBegSeq() -> <lResult>
* FlagShip compatible function
* Test if currently executed code is encapsulated inside
* begin sequence / end sequence statement activated by
* current or any upper level function/procedure
*
* Copyright 2010 Przemyslaw Czerpak <druzus@acn.waw.pl>
* www - http://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 "hbvmint.h"
#include "hbapi.h"
#include "hbstack.h"
HB_FUNC( ISBEGSEQ )
{
hb_retl( hb_stackGetRecoverBase() != 0 );
}

66
harbour/contrib/hbfship/isdb.prg Normal file
View File

@@ -0,0 +1,66 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* IsDbExcl() -> <lExclusive>
* IsDbFlock() -> <lFLocked>
* IsDbRLock( [ <xRec> ] ) -> <lLocked>
* FlagShip compatible functions
*
* Copyright 2010 Przemyslaw Czerpak <druzus@acn.waw.pl>
* www - http://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 "dbinfo.ch"
FUNCTION IsDbExcl()
RETURN ! DBINFO( DBI_SHARED )
FUNCTION IsDbFlock()
RETURN DBINFO( DBI_ISFLOCK )
FUNCTION IsDbRLock( xRec )
RETURN DBINFO( DBI_ISFLOCK ) .OR. ! DBINFO( DBI_SHARED ) .OR. ;
dbRecordInfo( DBRI_LOCKED, xRec )

71
harbour/contrib/hbfship/isfunc.c Normal file
View File

@@ -0,0 +1,71 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* IsFunction( <cName> ) -> <lExists>
* FlagShip compatible function
* Determines if a standard or user defined function/procedure
* is available (linked to the application and registered in VM)
*
* Copyright 2010 Przemyslaw Czerpak <druzus@acn.waw.pl>
* www - http://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"
HB_FUNC( ISFUNCTION )
{
const char * szProc = hb_parc( 1 );
HB_BOOL fResult = HB_FALSE;
if( szProc )
{
PHB_DYNS pDynSym = hb_dynsymFindName( szProc );
if( pDynSym )
fResult = hb_dynsymIsFunction( pDynSym );
}
hb_retl( fResult );
}

26
harbour/contrib/hbwin/axcore.c
View File

@@ -408,14 +408,14 @@ static HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID *
/* Method 1: using IProvideClassInfo2 */
hr = HB_VTBL( iDisp )->QueryInterface( HB_THIS_( iDisp ) HB_ID_REF( IID_IProvideClassInfo2 ), ( void** ) ( void* ) &iPCI2 );
if( hr == 0 )
if( hr == S_OK )
{
HB_TRACE( HB_TR_DEBUG, ("_get_default_sink IProvideClassInfo2 OK") );
hr = HB_VTBL( iPCI2 )->GetGUID( HB_THIS_( iPCI2 ) GUIDKIND_DEFAULT_SOURCE_DISP_IID, piid );
HB_VTBL( iPCI2 )->Release( HB_THIS( iPCI2 ) );
if( hr == 0 )
return 0;
if( hr == S_OK )
return S_OK;
}
else
{
@@ -426,20 +426,20 @@ static HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID *
/* Method 2: using IProvideClassInfo and searching for default source in ITypeInfo */
hr = HB_VTBL( iDisp )->QueryInterface( HB_THIS_( iDisp ) HB_ID_REF( IID_IProvideClassInfo ), ( void** ) ( void* ) &iPCI );
if( hr == 0 )
if( hr == S_OK )
{
HB_TRACE( HB_TR_DEBUG, ("_get_default_sink IProvideClassInfo OK") );
hr = HB_VTBL( iPCI )->GetClassInfo( HB_THIS_( iPCI ) &iTI );
if( hr == 0 )
if( hr == S_OK )
{
hr = HB_VTBL( iTI )->GetTypeAttr( HB_THIS_( iTI ) &pTypeAttr );
if( hr == 0 )
if( hr == S_OK )
{
for( i = 0; i < pTypeAttr->cImplTypes; i++ )
{
hr = HB_VTBL( iTI )->GetImplTypeFlags( HB_THIS_( iTI ) i, &iFlags );
if( hr == 0 && ( iFlags & IMPLTYPEFLAG_FDEFAULT ) && ( iFlags & IMPLTYPEFLAG_FSOURCE ) )
if( hr == S_OK && ( iFlags & IMPLTYPEFLAG_FDEFAULT ) && ( iFlags & IMPLTYPEFLAG_FSOURCE ) )
{
if( HB_VTBL( iTI )->GetRefTypeOfImplType( HB_THIS_( iTI ) i, &hRefType ) == S_OK &&
HB_VTBL( iTI )->GetRefTypeInfo( HB_THIS_( iTI ) hRefType, &iTISink ) == S_OK )
@@ -447,14 +447,14 @@ static HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID *
HB_TRACE( HB_TR_DEBUG, ("_get_default_sink Method 2: default source is found") );
hr = HB_VTBL( iTISink )->GetTypeAttr( HB_THIS_( iTISink ) &pTypeAttr );
if( hr == 0 )
if( hr == S_OK )
{
* piid = pTypeAttr->guid;
HB_VTBL( iTISink )->ReleaseTypeAttr( HB_THIS_( iTISink ) pTypeAttr );
HB_VTBL( iTI )->ReleaseTypeAttr( HB_THIS_( iTI ) pTypeAttr );
HB_VTBL( iPCI )->Release( HB_THIS( iPCI ) );
return 0;
return S_OK;
}
}
}
@@ -474,7 +474,7 @@ static HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID *
/* Method 3: using CoClass */
hr = HB_VTBL( iDisp )->GetTypeInfo( HB_THIS_( iDisp ) 0, LOCALE_SYSTEM_DEFAULT, &iTI );
if( hr == 0 )
if( hr == S_OK )
{
ITypeLib * iTL;
TYPEATTR * pTypeAttr2;
@@ -482,7 +482,7 @@ static HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID *
hr = HB_VTBL( iTI )->GetContainingTypeLib( HB_THIS_( iTI ) &iTL, NULL );
HB_VTBL( iTI )->Release( HB_THIS( iTI ) );
if( hr == 0 )
if( hr == S_OK )
{
int iCount = HB_VTBL( iTL )->GetTypeInfoCount( HB_THIS( iTL ) );
for( i = 0; i < iCount; i++ )
@@ -524,7 +524,7 @@ static HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID *
HB_VTBL( iTI )->ReleaseTypeAttr( HB_THIS_( iTI ) pTypeAttr );
HB_VTBL( iTI )->Release( HB_THIS( iTI ) );
HB_VTBL( iTL )->Release( HB_THIS( iTL ) );
return 0;
return S_OK;
}
}
@@ -560,7 +560,7 @@ static HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID *
HB_VTBL( iTI )->ReleaseTypeAttr( HB_THIS_( iTI ) pTypeAttr );
HB_VTBL( iTI )->Release( HB_THIS( iTI ) );
HB_VTBL( iTL )->Release( HB_THIS( iTL ) );
return 0;
return S_OK;
}
}
}

27
harbour/src/rdd/dbcmd.c
View File

@@ -995,15 +995,14 @@ HB_FUNC( FIELDPUT )
if( pArea )
{
HB_USHORT uiIndex = ( HB_FIELDNO ) hb_parni( 1 );
if( uiIndex > 0 )
{
PHB_ITEM pItem = hb_param( 2, HB_IT_ANY );
if( pItem && !HB_IS_NIL( pItem ) )
{
if( SELF_PUTVALUE( pArea, uiIndex, pItem ) == HB_SUCCESS )
{
hb_itemReturn( pItem );
}
}
}
}
@@ -2170,8 +2169,14 @@ HB_FUNC( HB_FIELDLEN )
if( pArea )
{
HB_USHORT uiIndex;
const char * szField = hb_parc( 1 );
if( ( uiIndex = ( HB_FIELDNO ) hb_parni( 1 ) ) > 0 )
if( szField )
uiIndex = hb_rddFieldIndex( pArea, szField );
else
uiIndex = ( HB_FIELDNO ) hb_parni( 1 );
if( uiIndex > 0 )
{
PHB_ITEM pItem = hb_itemNew( NULL );
@@ -2194,8 +2199,14 @@ HB_FUNC( HB_FIELDDEC )
if( pArea )
{
HB_USHORT uiIndex;
const char * szField = hb_parc( 1 );
if( ( uiIndex = ( HB_FIELDNO ) hb_parni( 1 ) ) > 0 )
if( szField )
uiIndex = hb_rddFieldIndex( pArea, szField );
else
uiIndex = ( HB_FIELDNO ) hb_parni( 1 );
if( uiIndex > 0 )
{
PHB_ITEM pItem = hb_itemNew( NULL );
@@ -2218,8 +2229,14 @@ HB_FUNC( HB_FIELDTYPE )
if( pArea )
{
HB_USHORT uiIndex;
const char * szField = hb_parc( 1 );
if( ( uiIndex = ( HB_FIELDNO ) hb_parni( 1 ) ) > 0 )
if( szField )
uiIndex = hb_rddFieldIndex( pArea, szField );
else
uiIndex = ( HB_FIELDNO ) hb_parni( 1 );
if( uiIndex > 0 )
{
PHB_ITEM pItem = hb_itemNew( NULL );