1220 lines
30 KiB
C
1220 lines
30 KiB
C
/*
|
|
* $Id$
|
|
*/
|
|
|
|
#include <extend.h>
|
|
#include <ctype.h>
|
|
#include <set.h>
|
|
|
|
extern STACK stack;
|
|
|
|
#define HB_ISSPACE(c) ((c) == 9 || (c) == 10 || (c) == 13 || (c) == 32)
|
|
|
|
HARBOUR HB_ALLTRIM( void );
|
|
HARBOUR HB_ISALPHA( void );
|
|
HARBOUR HB_ISDIGIT( void );
|
|
HARBOUR HB_ISUPPER( void );
|
|
HARBOUR HB_ISLOWER( void );
|
|
HARBOUR HB_PAD( void );
|
|
HARBOUR HB_PADC( void );
|
|
HARBOUR HB_PADL( void );
|
|
HARBOUR HB_PADR( void );
|
|
HARBOUR HB_RAT( void );
|
|
HARBOUR HB_RIGHT( void );
|
|
HARBOUR HB_STRTRAN( void );
|
|
HARBOUR HB_STUFF( void );
|
|
HARBOUR HB_TRIM( void );
|
|
|
|
static SYMBOL symbols[] = {
|
|
{ "ALLTRIM", FS_PUBLIC, HB_ALLTRIM, 0 },
|
|
{ "ISALPHA", FS_PUBLIC, HB_ISALPHA, 0 },
|
|
{ "ISDIGIT", FS_PUBLIC, HB_ISDIGIT, 0 },
|
|
{ "ISUPPER", FS_PUBLIC, HB_ISUPPER, 0 },
|
|
{ "ISLOWER", FS_PUBLIC, HB_ISLOWER, 0 },
|
|
{ "PAD" , FS_PUBLIC, HB_PAD , 0 },
|
|
{ "PADC" , FS_PUBLIC, HB_PADC , 0 },
|
|
{ "PADL" , FS_PUBLIC, HB_PADL , 0 },
|
|
{ "PADR" , FS_PUBLIC, HB_PADR , 0 },
|
|
{ "RAT" , FS_PUBLIC, HB_RAT , 0 },
|
|
{ "RIGHT" , FS_PUBLIC, HB_RIGHT , 0 },
|
|
{ "STRTRAN", FS_PUBLIC, HB_STRTRAN, 0 },
|
|
{ "STUFF" , FS_PUBLIC, HB_STUFF , 0 },
|
|
{ "TRIM" , FS_PUBLIC, HB_TRIM , 0 }
|
|
};
|
|
|
|
void Strings__InitSymbols( void )
|
|
{
|
|
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
|
|
}
|
|
|
|
BOOL hb_strempty( char * szText, ULONG ulLen )
|
|
{
|
|
BOOL bRetVal = TRUE;
|
|
|
|
while( ulLen-- )
|
|
{
|
|
char c = szText[ulLen];
|
|
|
|
if( !HB_ISSPACE( c ) )
|
|
{
|
|
bRetVal = FALSE;
|
|
break;
|
|
}
|
|
}
|
|
|
|
return bRetVal;
|
|
}
|
|
|
|
/* determines if first char of string is letter */
|
|
/* TEST: QOUT( "isalpha( 'hello' ) = ", isalpha( 'hello' ) ) */
|
|
/* TEST: QOUT( "isalpha( '12345' ) = ", isalpha( '12345' ) ) */
|
|
HARBOUR HB_ISALPHA( void )
|
|
{
|
|
_retl(isalpha(*_parc(1)));
|
|
}
|
|
|
|
/* determines if first char of string is digit */
|
|
/* TEST: QOUT( "isdigit( '12345' ) = ", isdigit( '12345' ) ) */
|
|
/* TEST: QOUT( "isdigit( 'abcde' ) = ", isdigit( 'abcde' ) ) */
|
|
HARBOUR HB_ISDIGIT( void )
|
|
{
|
|
_retl(isdigit(*_parc(1)));
|
|
}
|
|
|
|
/* determines if first char of string is upper-case */
|
|
/* TEST: QOUT( "isupper( 'Abcde' ) = ", isupper( 'Abcde' ) ) */
|
|
/* TEST: QOUT( "isupper( 'abcde' ) = ", isupper( 'abcde' ) ) */
|
|
HARBOUR HB_ISUPPER( void )
|
|
{
|
|
_retl(isupper(*_parc(1)));
|
|
}
|
|
|
|
/* determines if first char of string is lower-case */
|
|
/* TEST: QOUT( "islower( 'abcde' ) = ", islower( 'abcde' ) ) */
|
|
/* TEST: QOUT( "islower( 'Abcde' ) = ", islower( 'Abcde' ) ) */
|
|
HARBOUR HB_ISLOWER( void )
|
|
{
|
|
_retl(islower(*_parc(1)));
|
|
}
|
|
|
|
/* trims from the left, and returns a new pointer to szText */
|
|
/* also returns the new length in lLen */
|
|
char *hb_strLTrim( char *szText, ULONG *lLen )
|
|
{
|
|
while( *lLen && HB_ISSPACE(*szText) )
|
|
{
|
|
szText++;
|
|
(*lLen)--;
|
|
}
|
|
return szText;
|
|
}
|
|
|
|
/* trims leading spaces from a string */
|
|
/* TEST: QOUT( "ltrim( ' hello world ' ) = '" + ltrim( ' hello world ' ) + "'" ) */
|
|
HARBOUR HB_LTRIM( void )
|
|
{
|
|
if( _pcount() == 1 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
ULONG lLen = pText->wLength;
|
|
char *szText = hb_strLTrim(pText->value.szText, &lLen);
|
|
|
|
_retclen(szText, lLen);
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: LTRIM");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: LTRIM");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* returns szText and the new length in lLen */
|
|
ULONG hb_strRTrimLen( char *szText, ULONG lLen, BOOL bAnySpace )
|
|
{
|
|
if( bAnySpace )
|
|
{
|
|
while( lLen && HB_ISSPACE(szText[lLen - 1]) )
|
|
lLen--;
|
|
}
|
|
else
|
|
{
|
|
while( lLen && szText[lLen - 1] == ' ' )
|
|
lLen--;
|
|
}
|
|
return lLen;
|
|
}
|
|
|
|
|
|
/* trims trailing spaces from a string */
|
|
/* TEST: QOUT( "rtrim( ' hello world ' ) = '" + rtrim( ' hello world ' ) + "'" ) */
|
|
HARBOUR HB_RTRIM( void )
|
|
{
|
|
if( _pcount() > 0 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
if( pText )
|
|
{
|
|
BOOL bAnySpace = (_pcount() > 1? _parl(2): 0);
|
|
_retclen(pText->value.szText, hb_strRTrimLen(pText->value.szText, pText->wLength, bAnySpace));
|
|
}
|
|
else
|
|
/* Clipper doesn't error */
|
|
_retc("");
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: RTRIM");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* synonymn for RTRIM */
|
|
HARBOUR HB_TRIM( void )
|
|
{
|
|
HB_RTRIM();
|
|
}
|
|
|
|
/* trims leading and trailing spaces from a string */
|
|
/* TEST: QOUT( "alltrim( ' hello world ' ) = '" + alltrim( ' hello world ' ) + "'" ) */
|
|
HARBOUR HB_ALLTRIM( void )
|
|
{
|
|
if( _pcount() > 0 )
|
|
{
|
|
char *szText = _parc(1);
|
|
BOOL bAnySpace = (_pcount() > 1? _parl(2): 0);
|
|
ULONG lLen;
|
|
|
|
lLen = hb_strRTrimLen(szText, _parclen(1), bAnySpace);
|
|
|
|
szText = hb_strLTrim(szText, &lLen);
|
|
|
|
_retclen(szText, lLen);
|
|
}
|
|
else
|
|
/* Clipper doesn't error */
|
|
_retc("");
|
|
}
|
|
|
|
/* right-pads a string with spaces or supplied character */
|
|
/* TEST: QOUT( "padr( 'hello', 10 ) = '" + padr( 'hello', 10 ) + "'" ) */
|
|
HARBOUR HB_PADR( void )
|
|
{
|
|
char *szText = _parc(1);
|
|
|
|
if( _pcount() > 1 )
|
|
{
|
|
long lLen = _parnl(2);
|
|
|
|
if( lLen > (long)_parclen(1) )
|
|
{
|
|
char *szResult = (char *)_xgrab(lLen + 1);
|
|
long lPos;
|
|
char cPad;
|
|
|
|
memcpy(szResult, szText, _parclen(1));
|
|
|
|
cPad = ( _pcount() > 2? *(_parc(3)): ' ' );
|
|
|
|
for( lPos = _parclen(1); lPos < lLen; lPos++ )
|
|
szResult[lPos] = cPad;
|
|
|
|
_retclen(szResult, lLen);
|
|
_xfree(szResult);
|
|
}
|
|
else
|
|
_retclen(szText, (long)_parclen(1) );
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
|
|
/* synonymn for PADR */
|
|
HARBOUR HB_PAD( void )
|
|
{
|
|
HB_PADR();
|
|
}
|
|
|
|
/* left-pads a string with spaces or supplied character */
|
|
/* TEST: QOUT( "padl( 'hello', 10 ) = '" + padl( 'hello', 10 ) + "'" ) */
|
|
HARBOUR HB_PADL( void )
|
|
{
|
|
char *szText = _parc(1);
|
|
|
|
if( _pcount() > 1 )
|
|
{
|
|
long lLen = _parnl(2);
|
|
|
|
if( lLen > (long) _parclen(1) )
|
|
{
|
|
char *szResult = (char *)_xgrab(lLen + 1);
|
|
long lPos = lLen - _parclen(1);
|
|
char cPad;
|
|
|
|
memcpy(szResult + lPos, szText, _parclen(1));
|
|
|
|
cPad = (_pcount() > 2? *(_parc(3)): ' ');
|
|
|
|
for(; lPos > 0; lPos--)
|
|
{
|
|
szResult[lPos - 1] = cPad;
|
|
}
|
|
|
|
_retclen(szResult, lLen);
|
|
_xfree(szResult);
|
|
}
|
|
else
|
|
_retclen(szText, (long)_parclen(1) );
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
|
|
/* centre-pads a string with spaces or supplied character */
|
|
/* TEST: QOUT( "padc( 'hello', 10 ) = '" + padc( 'hello', 10 ) + "'" ) */
|
|
HARBOUR HB_PADC( void )
|
|
{
|
|
char *szText = _parc(1);
|
|
|
|
if( _pcount() > 1 )
|
|
{
|
|
long lLen = _parnl(2);
|
|
|
|
if( lLen > (long) _parclen(1) )
|
|
{
|
|
char *szResult = (char *)_xgrab(lLen + 1);
|
|
char cPad;
|
|
long w, lPos = (lLen - _parclen(1)) / 2;
|
|
|
|
memcpy(szResult + lPos, szText, _parclen(1) + 1);
|
|
|
|
cPad = ( _pcount() > 2? *_parc(3): ' ' );
|
|
|
|
for( w = 0; w < lPos; w++ )
|
|
szResult[w] = cPad;
|
|
|
|
for( w = _parclen(1) + lPos; w < lLen; w++ )
|
|
szResult[w] = cPad;
|
|
|
|
szResult[lLen] = 0;
|
|
|
|
_retclen(szResult, lLen);
|
|
_xfree(szResult);
|
|
}
|
|
else
|
|
_retclen(szText, (long)_parclen(1) );
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
|
|
ULONG hb_strAt(char *szSub, long lSubLen, char *szText, long lLen)
|
|
{
|
|
if( lSubLen )
|
|
{
|
|
if( lLen >= lSubLen )
|
|
{
|
|
long lPos = 0, lSubPos = 0;
|
|
|
|
while( lPos < lLen && lSubPos < lSubLen )
|
|
{
|
|
if( *(szText + lPos) == *(szSub + lSubPos) )
|
|
{
|
|
lSubPos++;
|
|
lPos++;
|
|
}
|
|
else if( lSubPos )
|
|
lSubPos = 0;
|
|
else
|
|
lPos++;
|
|
}
|
|
return (lSubPos < lSubLen? 0: lPos - lSubLen + 1);
|
|
}
|
|
else
|
|
return 0;
|
|
}
|
|
else
|
|
return 1;
|
|
}
|
|
|
|
/* locates a substring in a string */
|
|
/* TEST: QOUT( "at( 'cde', 'abcdefgfedcba' ) = '" + at( 'cde', 'abcdefgfedcba' ) + "'" ) */
|
|
HARBOUR HB_AT( void )
|
|
{
|
|
PHB_ITEM pSub = _param(1, IT_ANY);
|
|
PHB_ITEM pText = _param(2, IT_ANY);
|
|
|
|
if( pText && pSub )
|
|
{
|
|
if( IS_STRING( pText ) && IS_STRING( pSub ) )
|
|
{
|
|
_retnl( hb_strAt(pSub->value.szText, pSub->wLength, pText->value.szText, pText->wLength) );
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: AT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: AT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* locates a substring in a string starting at the end */
|
|
/* TEST: QOUT( "rat( 'cde', 'abcdefgfedcba' ) = '" + rat( 'cde', 'abcdefgfedcba' ) + "'" ) */
|
|
HARBOUR HB_RAT( void )
|
|
{
|
|
long lSubLen = _parclen(1);
|
|
|
|
if( lSubLen )
|
|
{
|
|
long lPos = _parclen(2) - lSubLen;
|
|
if( lPos < 0 )
|
|
_retni(0);
|
|
else
|
|
{
|
|
char *szSub = _parc(1);
|
|
char *szText = _parc(2);
|
|
int bFound = 0;
|
|
|
|
while( lPos >= 0 && !bFound )
|
|
{
|
|
if( *(szText + lPos) == *szSub )
|
|
bFound = !memcmp(szSub, szText + lPos, lSubLen);
|
|
lPos--;
|
|
}
|
|
_retnl( bFound? lPos + 2: 0 );
|
|
}
|
|
}
|
|
else
|
|
/* This function never seems to raise an error */
|
|
_retni(0);
|
|
}
|
|
|
|
/* converts an ASCII code to a character value */
|
|
HARBOUR HB_CHR( void )
|
|
{
|
|
if( _pcount() == 1 )
|
|
{
|
|
PHB_ITEM pAsc = _param(1, IT_NUMERIC);
|
|
|
|
if( pAsc )
|
|
{
|
|
char chr[2];
|
|
|
|
/* Believe it or not, clipper does this! */
|
|
chr[0] = _parnl(1) % 256;
|
|
chr[1] = 0;
|
|
_retclen(chr, 1);
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: CHR");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: CHR");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* converts a character value to an ASCII code */
|
|
HARBOUR HB_ASC(void)
|
|
{
|
|
if( _pcount() == 1 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
if( pText->wLength > 0 )
|
|
_retni(*(pText->value.szText));
|
|
else
|
|
_retni(0);
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: ASC");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: ASC");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* returns the left-most n characters in string */
|
|
HARBOUR HB_LEFT( void )
|
|
{
|
|
if( _pcount() == 2 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
PHB_ITEM pLen = _param(2, IT_NUMERIC);
|
|
|
|
if( pLen )
|
|
{
|
|
long lLen = _parnl(2);
|
|
|
|
if( lLen > pText->wLength )
|
|
lLen = pText->wLength;
|
|
|
|
else if( lLen < 0 )
|
|
lLen = 0;
|
|
|
|
_retclen(pText->value.szText, lLen);
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: LEFT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: LEFT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: LEFT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* returns the right-most n characters in string */
|
|
HARBOUR HB_RIGHT( void )
|
|
{
|
|
if( _pcount() == 2 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
PHB_ITEM pLen = _param(2, IT_NUMERIC);
|
|
|
|
if( pLen )
|
|
{
|
|
long lLen = _parnl(2);
|
|
|
|
if( lLen > pText->wLength )
|
|
lLen = pText->wLength;
|
|
|
|
else if( lLen < 0 )
|
|
lLen = 0;
|
|
|
|
_retclen(pText->value.szText + pText->wLength - lLen, lLen);
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: RIGHT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: RIGHT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: RIGHT");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* returns l characters from n characters into string */
|
|
HARBOUR HB_SUBSTR( void )
|
|
{
|
|
if( _pcount() > 1 && _pcount() < 4 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
PHB_ITEM pPos = _param(2, IT_NUMERIC);
|
|
|
|
if( pText && pPos )
|
|
{
|
|
long lPos = _parnl(2);
|
|
|
|
if( lPos < 0 )
|
|
{
|
|
lPos += pText->wLength;
|
|
if( lPos < 0 )
|
|
lPos = 0;
|
|
}
|
|
else if( lPos )
|
|
{
|
|
lPos--;
|
|
}
|
|
|
|
if( lPos < pText->wLength )
|
|
{
|
|
PHB_ITEM pLen = _param(3, IT_NUMERIC);
|
|
long lLen;
|
|
|
|
if( pLen )
|
|
{
|
|
lLen = _parnl(3);
|
|
|
|
if( lLen > pText->wLength - lPos )
|
|
lLen = pText->wLength - lPos;
|
|
}
|
|
else
|
|
lLen = pText->wLength - lPos;
|
|
|
|
if( lLen > 0 )
|
|
_retclen(pText->value.szText + lPos, lLen);
|
|
else
|
|
_retc("");
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: SUBSTR");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: SUBSTR");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* converts szText to lower case. Does not create a new string! */
|
|
char *hb_strLower(char *szText, long lLen)
|
|
{
|
|
long i;
|
|
for( i = 0; i < lLen; i++ )
|
|
szText[i] = tolower(szText[i]);
|
|
return szText;
|
|
}
|
|
|
|
/* converts string to lower case */
|
|
HARBOUR HB_LOWER( void )
|
|
{
|
|
if( _pcount() == 1 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
long lLen = pText->wLength;
|
|
|
|
_retclen(hb_strLower(pText->value.szText, lLen), lLen);
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: LOWER");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: LOWER");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* converts szText to upper case. Does not create a new string! */
|
|
char *hb_strUpper(char *szText, long lLen)
|
|
{
|
|
long i;
|
|
for( i = 0; i < lLen; i++ )
|
|
szText[i] = toupper(szText[i]);
|
|
return szText;
|
|
}
|
|
|
|
/* converts string to upper case */
|
|
HARBOUR HB_UPPER( void )
|
|
{
|
|
if( _pcount() == 1 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
long lLen = pText->wLength;
|
|
|
|
_retclen(hb_strUpper(pText->value.szText, lLen), lLen);
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: LOWER");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: LOWER");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* returns n copies of given string */
|
|
/* TEST: QOUT( "replicate( 'abc', 5 ) = " + replicate( 'abc', 5 ) ) */
|
|
HARBOUR HB_REPLICATE( void )
|
|
{
|
|
if( _pcount() == 2 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
PHB_ITEM pTimes = _param(2, IT_NUMERIC);
|
|
|
|
if( pText && pTimes )
|
|
{
|
|
long lTimes = _parnl(2);
|
|
|
|
if( lTimes > 0 )
|
|
{
|
|
char *szText = pText->value.szText;
|
|
long lLen = pText->wLength;
|
|
char *szResult = (char *)_xgrab((lLen * lTimes) + 1);
|
|
char *szPtr = szResult;
|
|
long i;
|
|
|
|
for( i = 0; i < lTimes; i++ )
|
|
{
|
|
memcpy(szPtr, szText, lLen);
|
|
szPtr += lLen;
|
|
}
|
|
_retclen(szResult, lLen * lTimes);
|
|
_xfree(szResult);
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: REPLICATE");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: REPLICATE");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* returns n copies of a single space */
|
|
/* TEST: QOUT( "space( 5 ) = '" + space( 5 ) + "'" ) */
|
|
HARBOUR HB_SPACE( void )
|
|
{
|
|
if( _pcount() == 1 )
|
|
{
|
|
PHB_ITEM pLen = _param(1, IT_NUMERIC);
|
|
|
|
if( pLen )
|
|
{
|
|
long lLen = _parnl(1);
|
|
|
|
if( lLen > 0 )
|
|
{
|
|
char *szResult = (char *)_xgrab(lLen + 1);
|
|
|
|
memset(szResult, ' ', lLen);
|
|
_retclen(szResult, lLen);
|
|
_xfree(szResult);
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: SPACE");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: SPACE");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* replaces characters in a string */
|
|
HARBOUR HB_STUFF( void )
|
|
{
|
|
PHB_ITEM pText;
|
|
|
|
pText = _param(1, IT_STRING);
|
|
if( pText )
|
|
{
|
|
char *szText = pText->value.szText;
|
|
PHB_ITEM pPos, pDel, pInsert;
|
|
long lPos, lDel, lInsert, lTotalLen;
|
|
char *szInsert;
|
|
|
|
pPos = _param(2, IT_NUMERIC);
|
|
lPos = (pPos? pPos->value.lNumber - 1: 0);
|
|
if( lPos > pText->wLength )
|
|
lPos = pText->wLength;
|
|
|
|
pDel = _param(3, IT_NUMERIC);
|
|
if( pDel )
|
|
{
|
|
lDel = pDel->value.lNumber;
|
|
if( lDel > pText->wLength - lPos )
|
|
lDel = pText->wLength - lPos;
|
|
}
|
|
else
|
|
lDel = 0;
|
|
|
|
pInsert = _param(4, IT_STRING);
|
|
if( pInsert )
|
|
{
|
|
szInsert = pInsert->value.szText;
|
|
lInsert = pInsert->wLength;
|
|
}
|
|
else
|
|
{
|
|
szInsert = ""; /* shouldn't matter that we don't allocate */
|
|
lInsert = 0;
|
|
}
|
|
|
|
if( (lTotalLen = pText->wLength + lInsert - lDel) > 0 )
|
|
{
|
|
char *szResult = (char *)_xgrab(lTotalLen + 1);
|
|
|
|
memcpy(szResult, szText, lPos);
|
|
memcpy(szResult + lPos, szInsert, lInsert);
|
|
memcpy(szResult + lPos + lInsert, szText + lPos + lDel,
|
|
pText->wLength - (lPos + lDel));
|
|
|
|
szResult[lTotalLen] = 0;
|
|
_retclen(szResult, lTotalLen);
|
|
_xfree(szResult);
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
|
|
/* replaces lots of characters in a string */
|
|
HARBOUR HB_STRTRAN( void )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
PHB_ITEM pSeek = _param(2, IT_STRING);
|
|
if( pSeek )
|
|
{
|
|
char *szText = pText->value.szText;
|
|
if( pSeek->wLength && pSeek->wLength <= pText->wLength )
|
|
{
|
|
char *szSeek = pSeek->value.szText;
|
|
PHB_ITEM pStart = _param(4, IT_NUMERIC);
|
|
char *szReplace;
|
|
long iStart;
|
|
|
|
iStart = (pStart? _parnl(4): 1);
|
|
if( !iStart )
|
|
{
|
|
/* Clipper seems to work this way */
|
|
_retc("");
|
|
}
|
|
else if( iStart > 0 )
|
|
{
|
|
PHB_ITEM pReplace = _param(3, IT_STRING);
|
|
PHB_ITEM pCount = _param(5, IT_NUMERIC);
|
|
long iReplace;
|
|
long iCount, bAll;
|
|
|
|
if( pReplace )
|
|
{
|
|
szReplace = pReplace->value.szText;
|
|
iReplace = pReplace->wLength;
|
|
}
|
|
else
|
|
{
|
|
szReplace = ""; /* shouldn't matter that we don't allocate */
|
|
iReplace = 0;
|
|
}
|
|
|
|
if( pCount )
|
|
{
|
|
iCount = pCount->value.lNumber;
|
|
bAll = 0;
|
|
}
|
|
else
|
|
{
|
|
iCount = 0;
|
|
bAll = 1;
|
|
}
|
|
|
|
if( bAll || iCount > 0 )
|
|
{
|
|
long iFound = 0;
|
|
long iReplaced = 0;
|
|
long i = 0;
|
|
long iLength = pText->wLength;
|
|
|
|
while( i < pText->wLength )
|
|
{
|
|
if( (bAll || iReplaced < iCount) && !memcmp(szText + i, szSeek, pSeek->wLength) )
|
|
{
|
|
iFound++;
|
|
if( iFound >= iStart )
|
|
{
|
|
iReplaced++;
|
|
iLength = iLength - pSeek->wLength + iReplace;
|
|
i += pSeek->wLength;
|
|
}
|
|
else
|
|
i++;
|
|
}
|
|
else
|
|
i++;
|
|
}
|
|
|
|
if( iFound )
|
|
{
|
|
char *szResult = (char *)_xgrab(iLength + 1);
|
|
char *szPtr = szResult;
|
|
|
|
iFound = 0;
|
|
i = 0;
|
|
while( i < pText->wLength )
|
|
{
|
|
if( iReplaced && !memcmp(szText + i, szSeek, pSeek->wLength) )
|
|
{
|
|
iFound++;
|
|
if( iFound >= iStart )
|
|
{
|
|
iReplaced--;
|
|
memcpy(szPtr, szReplace, iReplace);
|
|
szPtr += iReplace;
|
|
i += pSeek->wLength;
|
|
}
|
|
else
|
|
{
|
|
*szPtr = szText[i];
|
|
szPtr++;
|
|
i++;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
*szPtr = szText[i];
|
|
szPtr++;
|
|
i++;
|
|
}
|
|
}
|
|
_retclen(szResult, iLength);
|
|
_xfree(szResult);
|
|
}
|
|
else
|
|
_retclen(szText, pText->wLength);
|
|
}
|
|
else
|
|
_retclen(szText, pText->wLength);
|
|
}
|
|
else
|
|
_retclen(szText, pText->wLength);
|
|
}
|
|
else
|
|
_retclen(szText, pText->wLength);
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
else
|
|
_retc("");
|
|
}
|
|
|
|
/* returns the numeric value of a character string representation of a number */
|
|
double hb_strVal( char *szText )
|
|
{
|
|
return atof(szText);
|
|
}
|
|
|
|
/* returns the numeric value of a character string representation of a number */
|
|
HARBOUR HB_VAL( void )
|
|
{
|
|
if( _pcount() == 1 )
|
|
{
|
|
PHB_ITEM pText = _param(1, IT_STRING);
|
|
|
|
if( pText )
|
|
{
|
|
int nWidth, nDec = 0;
|
|
char * ptr = strchr( pText->value.szText, '.' );
|
|
if( ptr )
|
|
{
|
|
nWidth = ptr - pText->value.szText;
|
|
nDec = strlen( ptr + 1 );
|
|
}
|
|
else nWidth = strlen( pText->value.szText );
|
|
_retnd(hb_strVal(pText->value.szText));
|
|
stack.Return.wLength = nWidth;
|
|
stack.Return.wDec = nDec;
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: VAL");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: VAL");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
|
|
/* converts a numeric to a string with optional width & precision.
|
|
This function should be used by any function that wants to format numeric
|
|
data for displaying, printing, or putting in a database.
|
|
|
|
Note: The caller is responsible for calling _xfree to free the results buffer,
|
|
but ONLY if the return value is not a NULL pointer!
|
|
*/
|
|
char * hb_str( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
|
|
{
|
|
char * szResult = 0;
|
|
|
|
if( pNumber )
|
|
{
|
|
/* Default to the width and number of decimals specified by the item,
|
|
with a limit of 9 decimal places */
|
|
int iWidth = pNumber->wLength;
|
|
int iDec = pNumber->wDec;
|
|
|
|
if( iDec > 9 )
|
|
iDec = 9;
|
|
if( hb_set_fixed )
|
|
iDec = hb_set.HB_SET_DECIMALS;
|
|
|
|
if( pWidth )
|
|
{
|
|
/* If the width parameter is specified, override the default value
|
|
and set the number of decimals to zero */
|
|
if( IS_INTEGER( pWidth ) )
|
|
iWidth = pWidth->value.iNumber;
|
|
else if( IS_LONG( pWidth ) )
|
|
iWidth = (int) pWidth->value.lNumber;
|
|
else if( IS_DOUBLE( pWidth ) )
|
|
iWidth = (int) pWidth->value.dNumber;
|
|
|
|
if( iWidth < 1 )
|
|
iWidth = 10; /* If 0 or negative, use default */
|
|
iDec = 0;
|
|
}
|
|
|
|
if( pDec )
|
|
{
|
|
/* This function does not include the decimal places in the width,
|
|
so the width must be adjusted downwards, if the decimal places
|
|
parameter is greater than 0 */
|
|
if( IS_INTEGER( pDec ) )
|
|
iDec = pDec->value.iNumber;
|
|
else if( IS_LONG( pDec ) )
|
|
iDec = (int) pDec->value.lNumber;
|
|
else if( IS_DOUBLE( pDec ) )
|
|
iDec = (int) pDec->value.dNumber;
|
|
|
|
if( iDec < 0 )
|
|
iDec = 0;
|
|
else if( iDec > 0 )
|
|
iWidth -= (iDec + 1);
|
|
}
|
|
|
|
if( iWidth )
|
|
{
|
|
/* We at least have a width value */
|
|
int iBytes;
|
|
int iSize = (iDec ? iWidth + 1 + iDec : iWidth);
|
|
|
|
/* Be paranoid and use a large amount of padding */
|
|
szResult = (char *)_xgrab( iWidth + iDec + 64 );
|
|
|
|
if( IS_DOUBLE( pNumber ) || iDec != 0 )
|
|
{
|
|
double dNumber;
|
|
|
|
if( IS_INTEGER( pNumber ) )
|
|
dNumber = (double) pNumber->value.iNumber;
|
|
else if( IS_LONG( pNumber ) )
|
|
dNumber = (double) pNumber->value.lNumber;
|
|
else if( IS_DOUBLE( pNumber ) )
|
|
dNumber = pNumber->value.dNumber;
|
|
|
|
if( iDec > 0 )
|
|
iBytes = sprintf( szResult, "%*.*f", iSize, iDec, dNumber );
|
|
else
|
|
iBytes = sprintf( szResult, "%*ld", iWidth, (long)dNumber );
|
|
}
|
|
else switch( pNumber->wType & ~IT_BYREF )
|
|
{
|
|
case IT_LONG:
|
|
iBytes = sprintf( szResult, "%*li", iWidth, pNumber->value.lNumber );
|
|
break;
|
|
|
|
case IT_INTEGER:
|
|
iBytes = sprintf( szResult, "%*i", iWidth, pNumber->value.iNumber );
|
|
break;
|
|
|
|
default:
|
|
iBytes = 0;
|
|
*szResult = 0;
|
|
break;
|
|
}
|
|
/* Set to asterisks in case of overflow (same reason for paranoia) */
|
|
if( iBytes > iSize )
|
|
{
|
|
memset( szResult, '*', iSize );
|
|
szResult[ iSize ] = 0;
|
|
}
|
|
}
|
|
}
|
|
return( szResult );
|
|
}
|
|
|
|
/* converts a numeric to a string with optional width & precision.
|
|
calls hb_str() after validating parameters
|
|
*/
|
|
HARBOUR HB_STR( void )
|
|
{
|
|
if( _pcount() > 0 && _pcount() < 4 )
|
|
{
|
|
BOOL bValid = TRUE;
|
|
PHB_ITEM pNumber = _param( 1, IT_NUMERIC );
|
|
PHB_ITEM pWidth = 0;
|
|
PHB_ITEM pDec = 0;
|
|
|
|
if( !pNumber )
|
|
bValid = FALSE;
|
|
else
|
|
{
|
|
if( _pcount() > 1 )
|
|
{
|
|
pWidth = _param( 2, IT_NUMERIC );
|
|
if( !pWidth)
|
|
bValid = FALSE;
|
|
}
|
|
if( _pcount() > 2 )
|
|
{
|
|
pDec = _param( 3, IT_NUMERIC );
|
|
if( !pDec )
|
|
bValid = FALSE;
|
|
}
|
|
}
|
|
if( bValid )
|
|
{
|
|
char * szResult = hb_str( pNumber, pWidth, pDec );
|
|
|
|
if( szResult )
|
|
{
|
|
_retc( szResult );
|
|
_xfree( szResult );
|
|
}
|
|
else _retc( "" );
|
|
}
|
|
else
|
|
{
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Argument error: STR");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* QUESTION: Clipper catches this at compile time! */
|
|
PHB_ITEM pError = _errNew();
|
|
_errPutDescription(pError, "Incorrect number of arguments: STR");
|
|
_errLaunch(pError);
|
|
_errRelease(pError);
|
|
}
|
|
}
|