From 1dc1bba911e97b23cee4732446ede4f251c4f993 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Czerpak?= Date: Mon, 4 Nov 2013 16:54:27 +0100 Subject: [PATCH] 2013-11-04 16:54 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * contrib/hbfship/hbfship.hbp * contrib/hbfship/hbfship.hbx + contrib/hbfship/stroccur.prg + added undocumented FlagShip function: StrOccurs( , , [] ) -> It returns the number of occurrences of string in If is true (default) then it accepts any possible substring posittions otherwise (lAny == .F.) substrings cannot occupy common characters from , i.e. StrOccurs( "aa", "aaaa", .T. ) => 3 StrOccurs( "aa", "aaaa", .F. ) => 2 * contrib/hbfoxpro/hbfoxpro.hbp * contrib/hbfoxpro/hbfoxpro.hbx + contrib/hbfoxpro/dbfunc.c + added FoxPro compatible database functions: Filter(), Ndx(), Relation(), FSize(), __fox_Used(), __fox_Seek() * contrib/hbfoxpro/hbfoxpro.hbp * contrib/hbfoxpro/hbfoxpro.hbx + contrib/hbfoxpro/miscfunc.c + added few functions which can be directly translated to Harbour ones: Parameters() => PCount() SRows() => MaxRow() SCols() => MaxCol() VarRead() => ReadVar() PrintStatus() => IsPrinter() Key() => InedxKey() * contrib/hbfoxpro/hbfoxpro.hbx * contrib/hbfoxpro/misc.prg + added few new actions to Sys() function + added AElement(), Occurs() and InsMode() functions * contrib/hbfoxpro/hbfoxpro.ch + added PP rules for few FoxPro commands and standard functions with aliases, i.e. SEEK TAG IN lUsed := USED( ) nRecordsInWA := RECCOUNT( ) + added PP rules for SCAN / ENDSCAN + added few other commands ; Please verify me. I'm not [V]FP user and I cannot check what [V]FP exactly does. It's possible that I missed something or wrongly understood. ; Special thanks to Alex Antypenko. I took information about [V]FP functions and syntax analyzing his code. --- ChangeLog.txt | 50 +++++++++ contrib/gtwvg/gtwvg.hbx | 2 + contrib/hbfoxpro/dbfunc.c | 198 ++++++++++++++++++++++++++++++++++ contrib/hbfoxpro/hbfoxpro.ch | 37 +++++++ contrib/hbfoxpro/hbfoxpro.hbp | 3 + contrib/hbfoxpro/hbfoxpro.hbx | 15 +++ contrib/hbfoxpro/misc.prg | 39 +++++++ contrib/hbfoxpro/miscfunc.c | 57 ++++++++++ contrib/hbfship/hbfship.hbp | 1 + contrib/hbfship/hbfship.hbx | 1 + contrib/hbfship/stroccur.prg | 63 +++++++++++ 11 files changed, 466 insertions(+) create mode 100644 contrib/hbfoxpro/dbfunc.c create mode 100644 contrib/hbfoxpro/miscfunc.c create mode 100644 contrib/hbfship/stroccur.prg diff --git a/ChangeLog.txt b/ChangeLog.txt index 362f05d139..0fa2da4270 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -10,6 +10,56 @@ * Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment */ +2013-11-04 16:54 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) + * contrib/hbfship/hbfship.hbp + * contrib/hbfship/hbfship.hbx + + contrib/hbfship/stroccur.prg + + added undocumented FlagShip function: + StrOccurs( , , [] ) -> + It returns the number of occurrences of string in + If is true (default) then it accepts any possible substring + posittions otherwise (lAny == .F.) substrings cannot occupy common + characters from , i.e. + StrOccurs( "aa", "aaaa", .T. ) => 3 + StrOccurs( "aa", "aaaa", .F. ) => 2 + + * contrib/hbfoxpro/hbfoxpro.hbp + * contrib/hbfoxpro/hbfoxpro.hbx + + contrib/hbfoxpro/dbfunc.c + + added FoxPro compatible database functions: + Filter(), Ndx(), Relation(), FSize(), __fox_Used(), __fox_Seek() + + * contrib/hbfoxpro/hbfoxpro.hbp + * contrib/hbfoxpro/hbfoxpro.hbx + + contrib/hbfoxpro/miscfunc.c + + added few functions which can be directly translated to Harbour ones: + Parameters() => PCount() + SRows() => MaxRow() + SCols() => MaxCol() + VarRead() => ReadVar() + PrintStatus() => IsPrinter() + Key() => InedxKey() + + * contrib/hbfoxpro/hbfoxpro.hbx + * contrib/hbfoxpro/misc.prg + + added few new actions to Sys() function + + added AElement(), Occurs() and InsMode() functions + + * contrib/hbfoxpro/hbfoxpro.ch + + added PP rules for few FoxPro commands and standard functions with + aliases, i.e. + SEEK TAG IN + lUsed := USED( ) + nRecordsInWA := RECCOUNT( ) + + added PP rules for SCAN / ENDSCAN + + added few other commands + + ; Please verify me. I'm not [V]FP user and I cannot check what [V]FP + exactly does. It's possible that I missed something or wrongly + understood. + ; Special thanks to Alex Antypenko. I took information about [V]FP + functions and syntax analyzing his code. + 2013-11-01 01:21 UTC+0200 Mindaugas Kavaliauskas (dbtopas/at/dbtopas.lt) * src/compiler/hbopt.c ! fixed -w3 warning 'Variable ... is assigned but not used', reapplied diff --git a/contrib/gtwvg/gtwvg.hbx b/contrib/gtwvg/gtwvg.hbx index be8f3c1c09..cfc489f57f 100644 --- a/contrib/gtwvg/gtwvg.hbx +++ b/contrib/gtwvg/gtwvg.hbx @@ -250,6 +250,7 @@ DYNAMIC Wvt_CreateMenu DYNAMIC Wvt_CreatePopupMenu DYNAMIC Wvt_DeleteMenu DYNAMIC Wvt_DestroyMenu +DYNAMIC WVT_DESTROYPICTURE DYNAMIC Wvt_DialogBox DYNAMIC Wvt_DlgSetIcon DYNAMIC Wvt_DrawBoxGet @@ -318,6 +319,7 @@ DYNAMIC Wvt_LBSetCurSel DYNAMIC Wvt_LoadFont DYNAMIC Wvt_LoadPen DYNAMIC Wvt_LoadPicture +DYNAMIC WVT_LOADPICTUREEX DYNAMIC Wvt_LoadPictureFromResource DYNAMIC Wvt_LoadPictureFromResourceEx DYNAMIC Wvt_MakeDlgTemplate diff --git a/contrib/hbfoxpro/dbfunc.c b/contrib/hbfoxpro/dbfunc.c new file mode 100644 index 0000000000..13baae3f09 --- /dev/null +++ b/contrib/hbfoxpro/dbfunc.c @@ -0,0 +1,198 @@ +/* + * Harbour Project source code: + * FoxPro compatible database functions. + * + * Copyright 2013 Przemyslaw Czerpak + * 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.txt. 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 "hbapirdd.h" +#include "hbapierr.h" +#include "hbset.h" + +static AREAP s_foxAreaPointer( int iParam ) +{ + if( HB_ISNIL( iParam ) ) + return ( AREAP ) hb_rddGetCurrentWorkAreaPointer(); + else + { + const char * szAlias = hb_parc( iParam ); + int iArea; + + if( szAlias ) + hb_rddGetAliasNumber( szAlias, &iArea ); + else + iArea = hb_parni( iParam ); + + return ( AREAP ) hb_rddGetWorkAreaPointer( iArea ); + } +} + +HB_FUNC( FILTER ) +{ + AREAP pArea = s_foxAreaPointer( 1 ); + + if( pArea ) + { + PHB_ITEM pFilter = hb_itemPutC( NULL, NULL ); + SELF_FILTERTEXT( pArea, pFilter ); + hb_itemReturnRelease( pFilter ); + } + else + hb_retc_null(); +} + +HB_FUNC( NDX ) +{ + AREAP pArea = s_foxAreaPointer( 2 ); + + if( pArea ) + { + DBORDERINFO pOrderInfo; + memset( &pOrderInfo, 0, sizeof( pOrderInfo ) ); + pOrderInfo.itmOrder = hb_param( 1, HB_IT_NUMERIC ); + if( hb_itemGetNI( pOrderInfo.itmOrder ) == 0 ) + pOrderInfo.itmOrder = NULL; + pOrderInfo.itmResult = hb_itemPutC( NULL, NULL ); + SELF_ORDINFO( pArea, DBOI_NAME, &pOrderInfo ); + hb_itemReturnRelease( pOrderInfo.itmResult ); + } + else + hb_retc_null(); +} + +HB_FUNC( RELATION ) +{ + AREAP pArea = s_foxAreaPointer( 2 ); + + if( pArea ) + { + PHB_ITEM pRelExpr = hb_itemPutC( NULL, NULL ); + HB_USHORT uiRelNo = ( HB_USHORT ) hb_parni( 1 ); + SELF_RELTEXT( pArea, uiRelNo ? uiRelNo : 1, pRelExpr ); + hb_itemReturnRelease( pRelExpr ); + } + else + hb_retc_null(); +} + +HB_FUNC( FSIZE ) +{ + AREAP pArea = s_foxAreaPointer( 2 ); + + if( pArea ) + { + HB_FIELDNO uiIndex; + const char * szField; + + if( HB_ISNIL( 1 ) ) + uiIndex = 1; + else if( ( szField = hb_parc( 1 ) ) != NULL ) + uiIndex = hb_rddFieldIndex( pArea, szField ); + else + uiIndex = ( HB_FIELDNO ) hb_parni( 1 ); + + if( uiIndex > 0 ) + { + PHB_ITEM pItem = hb_itemNew( NULL ); + + if( SELF_FIELDINFO( pArea, uiIndex, DBS_LEN, pItem ) == HB_SUCCESS ) + { + hb_itemReturnRelease( pItem ); + return; + } + hb_itemRelease( pItem ); + } + } + + hb_retni( 0 ); +} + +HB_FUNC( __FOX_USED ) +{ + hb_retl( s_foxAreaPointer( 1 ) != NULL ); +} + +HB_FUNC( __FOX_SEEK ) +{ + AREAP pArea = s_foxAreaPointer( 4 ); + + if( pArea ) + { + if( ! HB_ISNIL( 1 ) ) + { + PHB_ITEM pKey = hb_param( 1, HB_IT_ANY ); + HB_BOOL fSoftSeek = HB_ISLOG( 2 ) ? ( HB_BOOL ) hb_parl( 2 ) : hb_setGetSoftSeek(); + HB_BOOL fFindLast = hb_parl( 3 ), fFound = HB_FALSE; + PHB_ITEM pTag = hb_param( 5, HB_IT_NUMERIC | HB_IT_STRING ); + HB_ERRCODE errCode = HB_SUCCESS; + + if( pTag ) + { + DBORDERINFO pInfo; + memset( &pInfo, 0, sizeof( pInfo ) ); + pInfo.itmOrder = pTag; + pInfo.itmResult = hb_itemNew( NULL ); + errCode = SELF_ORDLSTFOCUS( pArea, &pInfo ); + hb_itemRelease( pInfo.itmResult ); + } + + if( errCode == HB_SUCCESS ) + { + if( SELF_SEEK( pArea, fSoftSeek, pKey, fFindLast ) == HB_SUCCESS ) + { + if( SELF_FOUND( pArea, &fFound ) != HB_SUCCESS ) + fFound = HB_FALSE; + } + } + + hb_retl( fFound ); + } + else + hb_errRT_DBCMD( EG_ARG, EDBCMD_SEEK_BADPARAMETER, NULL, HB_ERR_FUNCNAME ); + } + else + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, HB_ERR_FUNCNAME ); +} diff --git a/contrib/hbfoxpro/hbfoxpro.ch b/contrib/hbfoxpro/hbfoxpro.ch index 4d636f12f6..47d9968b97 100644 --- a/contrib/hbfoxpro/hbfoxpro.ch +++ b/contrib/hbfoxpro/hbfoxpro.ch @@ -82,4 +82,41 @@ <{for}>, <{while}>, , ; , <.rest.>, <.prn.>, <(f)> ) + +/* commands and standard functions with alias */ +#command SEEK [] [] ; + [TAG ] [IN ] => ; + __fox_Seek( , iif( <.soft.>, .T., NIL ), ; + iif( <.last.>, .T., NIL ), ; + <(wa)>, <(tag)> ) +#command SET FILTER TO IN [NOOPTIMIZE] => ; + ->( DbSetFilter( <{exp}>, <"exp"> ) ) +#command SKIP [] IN => ->( DbSkip( ) ) +#command UNLOCK IN => ->( DbUnlock() ) +#command GO TOP IN => ->( DbGoTop() ) +#command GO BOTTOM IN => ->( DbGoBottom() ) +#command GOTO IN => ->( DbGoTo( ) ) + +#xtranslate SEEK( , ) => ()->( DbSeek( ) ) +#xtranslate RECCOUNT( ) => ()->( RecCount() ) +#xtranslate RECSIZE( ) => ()->( RecSize() ) +#xtranslate FCOUNT( ) => ()->( FCount() ) +#xtranslate RECNO( ) => ()->( RecNo() ) +#xtranslate RLOCK( ) => ()->( Rlock() ) + +#xtranslate USED( ) => __fox_Used( ) + + +/* other commands */ +#command SCAN [FOR ] [WHILE ] [NEXT ] ; + [RECORD ] [] [ALL] [NOOPTIMIZE] => ; + __dbLocate( <{for}>, <{while}>, , , <.rest.> ) ;; + WHILE Found() +#command ENDSCAN => __dbContinue(); ENDDO + +#command EJECT PAGE => __Eject() +#command FLUSH => DbCommitAll() +#command REGIONAL [] => LOCAL + + #endif /* HBFOXPRO_CH_ */ diff --git a/contrib/hbfoxpro/hbfoxpro.hbp b/contrib/hbfoxpro/hbfoxpro.hbp index 25a4b11819..2f7703e1ca 100644 --- a/contrib/hbfoxpro/hbfoxpro.hbp +++ b/contrib/hbfoxpro/hbfoxpro.hbp @@ -10,3 +10,6 @@ ${hb_name}.hbx dll.prg misc.prg + +dbfunc.c +miscfunc.c diff --git a/contrib/hbfoxpro/hbfoxpro.hbx b/contrib/hbfoxpro/hbfoxpro.hbx index d5f3e0c960..c141effbe5 100644 --- a/contrib/hbfoxpro/hbfoxpro.hbx +++ b/contrib/hbfoxpro/hbfoxpro.hbx @@ -21,9 +21,24 @@ #command DYNAMIC => EXTERNAL #endif +DYNAMIC AElement +DYNAMIC Filter DYNAMIC fox___DynCall +DYNAMIC FSize +DYNAMIC InsMode +DYNAMIC Key +DYNAMIC NDX +DYNAMIC Occurs +DYNAMIC Parameters +DYNAMIC PrintStatus +DYNAMIC Relation +DYNAMIC SCols +DYNAMIC SRows DYNAMIC Sys +DYNAMIC VarRead DYNAMIC __fox_Array +DYNAMIC __fox_Seek +DYNAMIC __fox_Used #if defined( __HBEXTREQ__ ) .OR. defined( __HBEXTERN__HBFOXPRO__REQUEST ) #uncommand DYNAMIC => EXTERNAL diff --git a/contrib/hbfoxpro/misc.prg b/contrib/hbfoxpro/misc.prg index 822273c0aa..cda99b7940 100644 --- a/contrib/hbfoxpro/misc.prg +++ b/contrib/hbfoxpro/misc.prg @@ -3,6 +3,7 @@ * Misc FoxPro functions (feel free to expand/fix it as you like) * * Copyright 2010 Viktor Szakats (vszakats.net/harbour) + * Copyright 2010-2013 Przemyslaw Czerpak * www - http://harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -47,6 +48,7 @@ */ #include "setcurs.ch" +#include "dbinfo.ch" FUNCTION Sys( nValue, xPar1 ) @@ -55,9 +57,27 @@ FUNCTION Sys( nValue, xPar1 ) RETURN NetName() + " # " + hb_UserName() CASE 2 RETURN hb_ntos( Seconds() ) + CASE 5 + RETURN Set( _SET_DEFAULT ) + CASE 6 + RETURN Set( _SET_PRINTFILE ) + CASE 10 + hb_default( @xPar1, 0 ) + RETURN CToD( "" ) + xPar1 + CASE 100 + RETURN iif( Set( _SET_CONSOLE ), "ON", "OFF" ) + CASE 101 + RETURN Set( _SET_DEVICE ) + CASE 102 + RETURN iif( Set( _SET_PRINTER ), "ON", "OFF" ) CASE 2002 hb_default( @xPar1, SC_NONE ) RETURN SetCursor( xPar1 ) + CASE 2011 + RETURN iif( ! dbInfo( DBOI_SHARED ), "Exclusive", ; + iif( dbInfo( DBI_ISFLOCK ), "File locked", ; + iif( dbRecordInfo( DBRI_LOCKED ), "Record locked", ; + "Not locked" ) ) ) OTHERWISE /* Throw RTE? */ ENDSWITCH @@ -80,3 +100,22 @@ STATIC FUNCTION AFillNested( aValue, xVal ) FUNCTION __fox_Array( ... ) RETURN AFillNested( Array( ... ), .F. ) + +FUNCTION AElement( aValue, ... ) + RETURN aValue[ ... ] + +FUNCTION Occurs( cSub, cStr ) + LOCAL nCount := 0, nFrom, nPos + + FOR nFrom := 1 to Len( cStr ) + IF ( nPos := hb_At( cSub, cStr, nFrom ) ) == 0 + EXIT + ENDIF + ++nCount + nFrom := nPos + NEXT + + RETURN nCount + +FUNCTION InsMode( ... ) + RETURN Set( _SET_INSERT, ... ) diff --git a/contrib/hbfoxpro/miscfunc.c b/contrib/hbfoxpro/miscfunc.c new file mode 100644 index 0000000000..5bb5e359ce --- /dev/null +++ b/contrib/hbfoxpro/miscfunc.c @@ -0,0 +1,57 @@ +/* + * Harbour Project source code: + * FoxPro compatible functions which can be directly translated to + * Harbour ones + * + * Copyright 2013 Przemyslaw Czerpak + * 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.txt. 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_TRANSLATE( PARAMETERS, PCOUNT ) +HB_FUNC_TRANSLATE( SROWS, MAXROW ) +HB_FUNC_TRANSLATE( SCOLS, MAXCOL ) +HB_FUNC_TRANSLATE( VARREAD, READVAR ) +HB_FUNC_TRANSLATE( PRINTSTATUS, ISPRINTER ) +HB_FUNC_TRANSLATE( KEY, INDEXKEY ) diff --git a/contrib/hbfship/hbfship.hbp b/contrib/hbfship/hbfship.hbp index d5206e4cbf..1c83660447 100644 --- a/contrib/hbfship/hbfship.hbp +++ b/contrib/hbfship/hbfship.hbp @@ -10,6 +10,7 @@ ${hb_name}.hbx fldarr.prg isdb.prg +stroccur.prg dbsetloc.c exec.c diff --git a/contrib/hbfship/hbfship.hbx b/contrib/hbfship/hbfship.hbx index 8e071a0c4f..0fdddcb6e7 100644 --- a/contrib/hbfship/hbfship.hbx +++ b/contrib/hbfship/hbfship.hbx @@ -35,6 +35,7 @@ DYNAMIC IsDbFLock DYNAMIC IsDbRLock DYNAMIC IsFunction DYNAMIC SecondsCPU +DYNAMIC StrOccurs DYNAMIC StrPeek DYNAMIC StrPoke DYNAMIC UsersMax diff --git a/contrib/hbfship/stroccur.prg b/contrib/hbfship/stroccur.prg new file mode 100644 index 0000000000..5ee2a802a6 --- /dev/null +++ b/contrib/hbfship/stroccur.prg @@ -0,0 +1,63 @@ +/* + * Harbour Project source code: + * StrOccurs( , ) -> + * Undocumented FlagShip compatible function + * + * Copyright 2013 Przemyslaw Czerpak + * 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.txt. 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 StrOccurs( cSub, cStr, lAny ) + LOCAL nCount := 0, nFrom, nPos + + hb_default( @lAny, .T. ) + + FOR nFrom := 1 to Len( cStr ) + IF ( nPos := hb_At( cSub, cStr, nFrom ) ) == 0 + EXIT + ENDIF + ++nCount + nFrom := iif( lAny, nPos, nPos + Len( cSub ) - 1 ) + NEXT + + RETURN nCount