diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 47525c7225..7dc4ecf623 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,27 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-07-07 04:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + + harbour/contrib/libct/dbftools.c + - harbour/contrib/libct/dattime2.prg + * harbour/contrib/libct/ctmath.h + * harbour/contrib/libct/Makefile + * harbour/contrib/libct/exponent.c + + harbour/contrib/libct/cttime.prg + * harbour/contrib/libct/ctstr.h + * harbour/contrib/libct/ct.h + + harbour/contrib/libct/disk.c + + harbour/contrib/libct/ctstrfil.c + + harbour/contrib/libct/ctstrfil.h + - harbour/contrib/libct/datetime.prg + - harbour/contrib/libct/pad.c + + harbour/contrib/libct/dattime2.c + + harbour/contrib/libct/ctpad.c + + harbour/contrib/libct/datetime.c + * synced with xHarbour modifications and fixes + ! some fixes + * indenting + 2007-07-06 23:15 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/contrib/libct/bitnum.c * harbour/contrib/libct/charlist.c diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index eeb9812d82..7a201d2c65 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -27,12 +27,17 @@ C_SOURCES = \ ctmath.c \ ctmath2.c \ ctnet.c \ + ctpad.c \ ctset.c \ ctstr.c \ ctchksum.c \ ctcrypt.c \ + ctstrfil.c \ ctwfunc.c \ ctwin.c \ + datetime.c \ + dattime2.c \ + disk.c \ exponent.c \ files.c \ finan.c \ @@ -42,7 +47,6 @@ C_SOURCES = \ misc1.c \ num1.c \ numat.c \ - pad.c \ pos1.c \ pos2.c \ posdiff.c \ @@ -65,8 +69,7 @@ PRG_SOURCES= \ color.prg \ ct.prg \ ctmisc.prg \ - datetime.prg \ - dattime2.prg \ + cttime.prg \ invrtwin.prg \ numconv.prg \ screen2.prg \ @@ -75,4 +78,3 @@ PRG_SOURCES= \ LIBNAME=ct include $(TOP)$(ROOT)config/lib.cf - diff --git a/harbour/contrib/libct/ct.h b/harbour/contrib/libct/ct.h index 720411983d..c37ff5da57 100644 --- a/harbour/contrib/libct/ct.h +++ b/harbour/contrib/libct/ct.h @@ -54,24 +54,32 @@ #ifndef _CT_H -# define _CT_H 1 +#define _CT_H 1 /* NOTE: we need this to prevent base types redefinition */ -# define _CLIPDEFS_H +#define _CLIPDEFS_H -# include "hbapi.h" -# include "hbapiitm.h" -# include "hbapierr.h" -# include "error.ch" -# include "hbmath.h" +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" +#include "error.ch" +#include "hbmath.h" -# include "ctstr.h" -# include "ctmath.h" -# include "ctset.h" +#include "ctstr.h" +#include "ctmath.h" +#include "ctset.h" -# include "cterror.ch" +#include "cterror.ch" -# define CT_SUBSYSTEM "CT" +#define CT_SUBSYSTEM "CT" + +#define CT_ARGERR_WHOCARES ES_WHOCARES +#define CT_ARGERR_WARNING ES_WARNING +#define CT_ARGERR_ERROR ES_ERROR +#define CT_ARGERR_CATASTROPHIC ES_CATASTROPHIC +#define CT_ARGERR_IGNORE -1 + +HB_EXTERN_BEGIN /* CT subsystem error throwing functions */ extern USHORT ct_error( USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, @@ -84,10 +92,6 @@ extern PHB_ITEM ct_error_subst( USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubC extern void ct_setargerrormode( int iMode ); extern int ct_getargerrormode( void ); -# define CT_ARGERR_WHOCARES ES_WHOCARES -# define CT_ARGERR_WARNING ES_WARNING -# define CT_ARGERR_ERROR ES_ERROR -# define CT_ARGERR_CATASTROPHIC ES_CATASTROPHIC -# define CT_ARGERR_IGNORE -1 +HB_EXTERN_END #endif diff --git a/harbour/contrib/libct/ctmath.h b/harbour/contrib/libct/ctmath.h index 31f625e335..c851b41558 100644 --- a/harbour/contrib/libct/ctmath.h +++ b/harbour/contrib/libct/ctmath.h @@ -62,6 +62,8 @@ #include #include +HB_EXTERN_BEGIN + /* initialization */ extern int ct_math_init( void ); extern int ct_math_exit( void ); @@ -74,4 +76,6 @@ extern int ct_getprecision( void ); #define CT_PI_2 1.57079632679489661923 #define CT_PI_RAD 0.0174532925199432957692 /* 3.14159265358979323846 / 180.0 */ +HB_EXTERN_END + #endif /* CTMATH_H */ diff --git a/harbour/contrib/libct/pad.c b/harbour/contrib/libct/ctpad.c similarity index 59% rename from harbour/contrib/libct/pad.c rename to harbour/contrib/libct/ctpad.c index c25ef4f8cb..96a80606d2 100644 --- a/harbour/contrib/libct/pad.c +++ b/harbour/contrib/libct/ctpad.c @@ -1,5 +1,5 @@ /* - * $Id$ + * $Id: pad.c 4527 2001-10-20 05:40:55Z paultucker $ */ /* @@ -52,114 +52,96 @@ * */ - #include "ct.h" - /* defines */ #define DO_PAD_PADLEFT 0 #define DO_PAD_PADRIGHT 1 /* helper function for the pad functions */ -static void do_pad (int iSwitch) +static void do_pad( int iSwitch ) { + if( ISCHAR( 1 ) && ISNUM( 2 ) ) + { + char *pcString = ( char * ) hb_parc( 1 ); + size_t sStrLen = ( size_t ) hb_parclen( 1 ); + char *pcRet, *pc; + LONG lRetLen; + size_t sRetLen; + char cFill; - if (ISCHAR (1) && ISNUM (2)) - { - - char *pcString = (char *)hb_parc (1); - size_t sStrLen = (size_t)hb_parclen (1); - char *pcRet, *pc; - long lRetLen; - size_t sRetLen; - char cFill; - - lRetLen = hb_parnl (2); - if (lRetLen <= 0) - { - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) + lRetLen = hb_parnl( 2 ); + if( lRetLen <= 0 ) { - ct_error ((USHORT)iArgErrorMode, EG_ARG, - (iSwitch == DO_PAD_PADLEFT ? CT_ERROR_PADLEFT : CT_ERROR_PADRIGHT), - NULL, - (iSwitch == DO_PAD_PADLEFT ? "PADLEFT" : "ROR_PADRIGHT"), - 0, EF_CANDEFAULT, 3, - hb_paramError (1), hb_paramError (2), - hb_paramError (3)); + int iArgErrorMode = ct_getargerrormode(); + + if( iArgErrorMode != CT_ARGERR_IGNORE ) + { + ct_error( ( USHORT ) iArgErrorMode, EG_ARG, + iSwitch == DO_PAD_PADLEFT ? + CT_ERROR_PADLEFT : CT_ERROR_PADRIGHT, NULL, + &hb_errFuncName, 0, EF_CANDEFAULT, + HB_ERR_ARGS_BASEPARAMS ); + } + hb_retc( NULL ); + return; } - hb_retc (""); - return; - } - sRetLen = (size_t)lRetLen; + sRetLen = ( size_t ) lRetLen; - if (hb_parclen (3) > 0) - cFill = *(hb_parc (3)); - else if (ISNUM (3)) - cFill = hb_parnl (3) % 256; - else - cFill = 0x20; + if( hb_parclen( 3 ) > 0 ) + cFill = *( hb_parc( 3 ) ); + else if( ISNUM( 3 ) ) + cFill = ( char ) ( hb_parnl( 3 ) % 256 ); + else + cFill = 0x20; - pcRet = ( char * )hb_xgrab (sRetLen); + pcRet = ( char * ) hb_xgrab( sRetLen + 1 ); - if (iSwitch == DO_PAD_PADLEFT) - { - if (sRetLen > sStrLen) + if( iSwitch == DO_PAD_PADLEFT ) { - /* fill with cFill */ - for (pc = pcRet; pc < pcRet+(sRetLen-sStrLen); pc++) - *pc = cFill; - hb_xmemcpy (pcRet+(sRetLen-sStrLen), pcString, sStrLen); + if( sRetLen > sStrLen ) + { + /* fill with cFill */ + for( pc = pcRet; pc < pcRet + ( sRetLen - sStrLen ); pc++ ) + *pc = cFill; + hb_xmemcpy( pcRet + ( sRetLen - sStrLen ), pcString, sStrLen ); + } + else + { + hb_xmemcpy( pcRet, pcString + ( sStrLen - sRetLen ), sRetLen ); + } } else { - hb_xmemcpy (pcRet, pcString+(sStrLen-sRetLen), sRetLen); + hb_xmemcpy( pcRet, pcString, ( sRetLen < sStrLen ? sRetLen : sStrLen ) ); + if( sRetLen > sStrLen ) + { + /* fill with cFill */ + for( pc = pcRet + sStrLen; pc < pcRet + sRetLen; pc++ ) + *pc = cFill; + } } - } - else - { - hb_xmemcpy (pcRet, pcString, (sRetLen < sStrLen ? sRetLen : sStrLen)); - if (sRetLen > sStrLen) + hb_retclen_buffer( pcRet, sRetLen ); + } + else /* ISCHAR( 1 ) && ISNUM( 2 ) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + + if( iArgErrorMode != CT_ARGERR_IGNORE ) { - /* fill with cFill */ - for (pc = pcRet+sStrLen; pc < pcRet+sRetLen; pc++) - *pc = cFill; + pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG, + iSwitch == DO_PAD_PADLEFT ? + CT_ERROR_PADLEFT : CT_ERROR_PADRIGHT, NULL, + &hb_errFuncName, 0, EF_CANSUBSTITUTE, + HB_ERR_ARGS_BASEPARAMS ); } - } - - hb_retclen (pcRet, sRetLen); - hb_xfree (pcRet); - - } - else /* ISCHAR (1) && ISNUM (2) */ - { - PHB_ITEM pSubst = NULL; - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) - { - pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, - (iSwitch == DO_PAD_PADLEFT ? CT_ERROR_PADLEFT : CT_ERROR_PADRIGHT), - NULL, - (iSwitch == DO_PAD_PADLEFT ? "PADLEFT" : "ROR_PADRIGHT"), - 0, EF_CANSUBSTITUTE, 3, - hb_paramError (1), hb_paramError (2), - hb_paramError (3)); - } - - if (pSubst != NULL) - { - hb_itemReturn (pSubst); - hb_itemRelease (pSubst); - } - else - { - hb_retc (""); - } - return; - } - - return; + if( pSubst != NULL ) + hb_itemReturnRelease( pSubst ); + else + hb_retc( NULL ); + } } @@ -191,12 +173,9 @@ static void do_pad (int iSwitch) * $END$ */ -HB_FUNC (PADLEFT) +HB_FUNC( PADLEFT ) { - - do_pad (DO_PAD_PADLEFT); - return; - + do_pad( DO_PAD_PADLEFT ); } @@ -228,10 +207,7 @@ HB_FUNC (PADLEFT) * $END$ */ -HB_FUNC (PADRIGHT) +HB_FUNC( PADRIGHT ) { - - do_pad (DO_PAD_PADRIGHT); - return; - + do_pad( DO_PAD_PADRIGHT ); } diff --git a/harbour/contrib/libct/ctstr.h b/harbour/contrib/libct/ctstr.h index 8fdf97373d..0ee7c95e72 100644 --- a/harbour/contrib/libct/ctstr.h +++ b/harbour/contrib/libct/ctstr.h @@ -56,6 +56,8 @@ #ifndef _CTSTR_H #define _CTSTR_H 1 +HB_EXTERN_BEGIN + extern int ct_str_init( void ); extern int ct_str_exit( void ); @@ -90,4 +92,6 @@ extern char ct_getatlikechar( void ); #define CT_SETATLIKE_EXACT 0 #define CT_SETATLIKE_WILDCARD 1 +HB_EXTERN_END + #endif diff --git a/harbour/contrib/libct/ctstrfil.c b/harbour/contrib/libct/ctstrfil.c new file mode 100644 index 0000000000..f362c16b34 --- /dev/null +++ b/harbour/contrib/libct/ctstrfil.c @@ -0,0 +1,268 @@ +/* + * $Id$ + */ + +/* + * xHarbour Project source code: + * Functions: + * SETFCREATE(), CSETSAFETY(), STRFILE(), FILESTR(), SCREENFILE() + * SCREENFILE(), FILESCREEN() + * + * Copyright 2004 Pavel Tsarenko + * www - http://www.xharbour.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "hbapi.h" +#include "hbapifs.h" +#include "hbapigt.h" + + +static int s_iFileAttr = HB_FA_NORMAL; +static BOOL s_bSafety = 0; + +void ct_setfcreate( int iFileAttr ) +{ + HB_TRACE( HB_TR_DEBUG, ( "ct_setfcreate(%i)", iFileAttr ) ); + s_iFileAttr = iFileAttr; +} + +int ct_getfcreate( void ) +{ + HB_TRACE( HB_TR_DEBUG, ( "ct_getfcreate()" ) ); + return s_iFileAttr; +} + +HB_FUNC( SETFCREATE ) +{ + hb_retni( ct_getfcreate() ); + + if( ISNUM( 1 ) ) + { + ct_setfcreate( hb_parni( 1 ) ); + } +} + +void ct_setsafety( BOOL bSafety ) +{ + HB_TRACE( HB_TR_DEBUG, ( "ct_setsafety(%i)", bSafety ) ); + s_bSafety = bSafety; +} + +BOOL ct_getsafety( void ) +{ + HB_TRACE( HB_TR_DEBUG, ( "ct_getsafety()" ) ); + return s_bSafety; +} + +HB_FUNC( CSETSAFETY ) +{ + hb_retni( ct_getsafety() ); + + if( ISLOG( 1 ) ) + { + ct_setsafety( hb_parnl( 1 ) ); + } +} + +static LONG ct_StrFile( BYTE * pFileName, BYTE * pcStr, ULONG ulLen, BOOL bOverwrite, LONG lOffset, + BOOL bTrunc ) +{ + FHANDLE hFile; + BOOL bOpen = FALSE; + BOOL bFile = hb_fsFile( pFileName ); + ULONG ulWrite = 0; + + if( bFile && bOverwrite ) + { + hFile = hb_fsOpen( pFileName, FO_READWRITE ); + bOpen = TRUE; + } + else if( !bFile || !ct_getsafety() ) + { + hFile = hb_fsCreate( pFileName, ct_getfcreate() ); + } + else + { + hFile = FS_ERROR; + } + + if( hFile != FS_ERROR ) + { + if( lOffset ) + hb_fsSeek( hFile, lOffset, FS_SET ); + else if( bOpen ) + hb_fsSeek( hFile, 0, FS_END ); + + ulWrite = hb_fsWriteLarge( hFile, pcStr, ulLen ); + if( ( ulWrite == ulLen ) && bOpen && bTrunc ) + hb_fsWrite( hFile, NULL, 0 ); + + hb_fsClose( hFile ); + } + return ulWrite; +} + +HB_FUNC( STRFILE ) +{ + if( ISCHAR( 1 ) && ISCHAR( 2 ) ) + { + hb_retnl( ct_StrFile( ( BYTE * ) hb_parc( 2 ), ( BYTE * ) hb_parc( 1 ), + hb_parclen( 1 ), ISLOG( 3 ) && hb_parl( 3 ), + hb_parnl( 4 ), ISLOG( 5 ) && hb_parl( 5 ) ) ); + } + else + { + hb_retni( 0 ); + } +} + +HB_FUNC( FILESTR ) +{ + if( ISCHAR( 1 ) ) + { + FHANDLE hFile = hb_fsOpen( ( BYTE * ) hb_parc( 1 ), FO_READ ); + + if( hFile != FS_ERROR ) + { + LONG lFileSize = hb_fsSeek( hFile, 0, FS_END ); + LONG lPos = hb_fsSeek( hFile, hb_parnl( 3 ), FS_SET ), lLength; + char *pcResult, *pCtrlZ; + BOOL bCtrlZ = ISLOG( 4 ) && hb_parl( 4 ); + + if( ISNUM( 2 ) ) + { + lLength = hb_parnl( 2 ); + if( lLength > lFileSize - lPos ) + lLength = lFileSize - lPos; + } + else + lLength = lFileSize - lPos; + + pcResult = ( char * ) hb_xgrab( lLength + 1 ); + if( lLength > 0 ) + { + lLength = hb_fsReadLarge( hFile, ( BYTE * ) pcResult, ( ULONG ) lLength ); + } + + if( bCtrlZ ) + { + pCtrlZ = ( char * ) memchr( pcResult, 26, lLength ); + if( pCtrlZ ) + lLength = pCtrlZ - pcResult; + } + + hb_fsClose( hFile ); + hb_retclen_buffer( pcResult, lLength ); + } + else + { + hb_retc( NULL ); + } + } + else + { + hb_retc( NULL ); + } +} + +HB_FUNC( SCREENFILE ) +{ + if( ISCHAR( 1 ) ) + { + char *pBuffer; + ULONG ulSize; + + hb_gtRectSize( 0, 0, hb_gtMaxRow(), hb_gtMaxCol(), &ulSize ); + pBuffer = ( char * ) hb_xgrab( ulSize ); + + hb_gtSave( 0, 0, hb_gtMaxRow(), hb_gtMaxCol(), pBuffer ); + + hb_retnl( ct_StrFile( ( BYTE * ) hb_parc( 1 ), ( BYTE * ) pBuffer, + ulSize, ISLOG( 2 ) && hb_parl( 2 ), hb_parnl( 3 ), + ISLOG( 4 ) && hb_parl( 4 ) ) ); + hb_xfree( pBuffer ); + } + else + { + hb_retni( 0 ); + } +} + +HB_FUNC( FILESCREEN ) +{ + if( ISCHAR( 1 ) ) + { + FHANDLE hFile = hb_fsOpen( ( BYTE * ) hb_parc( 1 ), FO_READ ); + + if( hFile != FS_ERROR ) + { + char *pBuffer; + ULONG ulSize; + LONG lLength; + + if( ISNUM( 2 ) ) + { + hb_fsSeek( hFile, hb_parnl( 2 ), FS_SET ); + } + + hb_gtRectSize( 0, 0, hb_gtMaxRow(), hb_gtMaxCol(), &ulSize ); + pBuffer = ( char * ) hb_xgrab( ulSize ); + + lLength = hb_fsRead( hFile, ( BYTE * ) pBuffer, ulSize ); + hb_gtRest( 0, 0, hb_gtMaxRow(), hb_gtMaxCol(), pBuffer ); + + hb_xfree( pBuffer ); + + hb_fsClose( hFile ); + hb_retnl( lLength ); + } + else + { + hb_retni( 0 ); + } + } + else + { + hb_retni( 0 ); + } +} diff --git a/harbour/contrib/libct/ctstrfil.h b/harbour/contrib/libct/ctstrfil.h new file mode 100644 index 0000000000..96098ae0b5 --- /dev/null +++ b/harbour/contrib/libct/ctstrfil.h @@ -0,0 +1,63 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Header file for Clipper Tools like window system + * + * Copyright 2007 Przemyslaw Czerpak + * 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 HB_CTSTRFIL_H_ +#define HB_CTSTRFIL_H_ + +HB_EXTERN_BEGIN + +extern BOOL ct_getsafety( void ); +extern void ct_setsafety( BOOL bSafety ); + +HB_EXTERN_END + +#endif /* HB_CTSTRFIL_H_ */ diff --git a/harbour/contrib/libct/cttime.prg b/harbour/contrib/libct/cttime.prg new file mode 100644 index 0000000000..812f95c953 --- /dev/null +++ b/harbour/contrib/libct/cttime.prg @@ -0,0 +1,99 @@ +/* + * $Id$ + */ + +/* + * xHarbour Project source code: + * TIMETOSEC(), SECTOTIME(), MILLISEC() + * + * Copyright 2003 Piero Vincenzo Lupano + * Copyright 2003 Przemyslaw Czerpak + * www - http://www.xharbour.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +function TIMETOSEC( cTime ) +local nSec := 0, nLen, i, aLim, aMod, nInd, n +if cTime == NIL + nSec := seconds() +elseif valtype( cTime ) == "C" + nLen := len( cTime ) + if ( nLen + 1 ) % 3 == 0 .and. nLen <= 11 + nInd := 1 + aLim := { 24, 60, 60, 100 } + aMod := { 3600, 60, 1, 1/100 } + for i := 1 to nLen step 3 + if isdigit( substr( cTime, i, 1 ) ) .and. ; + isdigit( substr( cTime, i + 1, 1 ) ) .and. ; + ( i == nLen - 1 .or. substr( cTime, i + 2, 1 ) == ":" ) .and. ; + ( n := val( substr( cTime, i, 2 ) ) ) < aLim[ nInd ] + nSec += n * aMod[ nInd ] + else + nSec := 0 + exit + endif + ++nInd + next + endif +endif +return round( nSec, 2) /* round FL val to be sure that you can compare it */ + + +function SECTOTIME( nSec, lHundr ) +local i, h, n +n := iif( !valtype( nSec ) == "N", seconds(), nSec ) +if valtype( lHundr ) == "L" .and. lHundr + h := ":" + strzero( ( nSec * 100 ) % 100, 2 ) +else + h := "" +endif +n := int( n % 86400 ) +for i := 1 to 3 + h := strzero( n % 60, 2 ) + h + n := int( n / 60 ) +next +return h + + +function MILLISEC( nDelay ) +HB_IDLESLEEP( nDelay / 1000 ) +return "" diff --git a/harbour/contrib/libct/datetime.prg b/harbour/contrib/libct/datetime.c similarity index 60% rename from harbour/contrib/libct/datetime.prg rename to harbour/contrib/libct/datetime.c index 1d37ec3f90..c8a263ed23 100644 --- a/harbour/contrib/libct/datetime.prg +++ b/harbour/contrib/libct/datetime.c @@ -7,9 +7,9 @@ * CT3 Date & Time functions: - BOM() / EOM() * - BOQ() / EOQ() * - BOY() / EOY() - * - STOD() + * - WOM() * - * Copyright 1999-2001 Marek Horodyski + * Copyright 2005 Pavel Tsarenko * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -54,6 +54,22 @@ */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 1999 Jose Lalin + * Wom() + * + * See doc/license.txt for licensing terms. + * + */ + + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbdate.h" + /* $DOC$ * $FUNCNAME$ * BOM() @@ -81,12 +97,32 @@ * EOM(),BOQ(),EOQ(),BOY(),EOY() * $END$ */ -Function BOM( date) - date := If( ValType( date) == 'D', date, Date()) - if (empty(date)) - return (date) - endif - Return StoD( SubStr( DtoS( date), 1, 6) + '01') + +HB_FUNC( BOM ) +{ + LONG lDate; + int iYear, iMonth, iDay; + + if( ISNIL( 1 ) ) + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + else + { + lDate = hb_pardl( 1 ); + } + + if( lDate != 0 ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + hb_retd( iYear, iMonth, 1 ); + } + else + { + hb_retdl( 0 ); + } +} /* $DOC$ @@ -116,16 +152,38 @@ Function BOM( date) * BOM(),BOQ(),EOQ(),BOY(),EOY() * $END$ */ -Function EOM( date) - Local m - date := If( ValType( date) == 'D', date, Date()) - if (empty(date)) - return (date) - endif - m := Month( date) - While Month( ++date) == m - End - Return --date + +HB_FUNC( EOM ) +{ + LONG lDate; + int iYear, iMonth, iDay; + + if( ISNIL( 1 ) ) + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + else + { + lDate = hb_pardl( 1 ); + } + + if( lDate != 0 ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + iMonth++; + if( iMonth > 12 ) + { + iMonth = 1; + iYear++; + } + hb_retdl( hb_dateEncode( iYear, iMonth, 1 ) - 1 ); + } + else + { + hb_retdl( 0 ); + } +} /* $DOC$ @@ -155,23 +213,34 @@ Function EOM( date) * BOM(),EOM(),EOQ(),BOY(),EOY() * $END$ */ -Function BOQ( date) - Local boq AS DATE, m AS NUMERIC, yyyy AS STRING - date := If( ValType( date) == 'D', date, Date()) - if (empty(date)) - return (date) - endif - yyyy := Str( Year( date), 4, 0) - If ( m := Month( date)) <= 3 - boq := StoD( yyyy + '0101') - ElseIf m <= 6 - boq := StoD( yyyy + '0401') - ElseIf m <= 9 - boq := StoD( yyyy + '0701') - Else - boq := StoD( yyyy + '1001') - End -Return boq + +HB_FUNC( BOQ ) +{ + LONG lDate; + int iYear, iMonth, iDay; + + if( ISNIL( 1 ) ) + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + else + { + lDate = hb_pardl( 1 ); + } + + if( lDate != 0 ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + iMonth -= ( iMonth - 1 ) % 3; + + hb_retd( iYear, iMonth, 1 ); + } + else + { + hb_retdl( 0 ); + } +} /* $DOC$ @@ -201,23 +270,39 @@ Return boq * BOM(),EOM(),BOQ(),BOY(),EOY() * $END$ */ -Function EOQ( date) - Local m AS NUMERIC, eoq AS DATE, yyyy AS STRING - date := If( ValType( date) == 'D', date, Date()) - if (empty(date)) - return (date) - endif - yyyy := Str( Year( date), 4, 0) - If ( m := Month( date)) <= 3 - eoq := StoD( yyyy + '0331') - ElseIf m <= 6 - eoq := StoD( yyyy + '0630') - ElseIf m <= 9 - eoq := StoD( yyyy + '0930') - Else - eoq := StoD( yyyy + '1231') - End - Return eoq + +HB_FUNC( EOQ ) +{ + LONG lDate; + int iYear, iMonth, iDay; + + if( ISNIL( 1 ) ) + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + else + { + lDate = hb_pardl( 1 ); + } + + if( lDate != 0 ) + { + + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + iMonth += 3 - ( ( iMonth - 1 ) % 3 ); + if( iMonth > 12 ) + { + iMonth = 1; + iYear++; + } + hb_retdl( hb_dateEncode( iYear, iMonth, 1 ) - 1 ); + } + else + { + hb_retdl( 0 ); + } +} /* $DOC$ @@ -247,12 +332,32 @@ Function EOQ( date) * BOM(),EOM(),BOQ(),EOQ(),EOY() * $END$ */ -Function BOY( date) - date := If( ValType( date) == 'D', date, Date()) - if (empty(date)) - return (date) - endif - Return StoD( Str( Year( date), 4, 0) + '0101') + +HB_FUNC( BOY ) +{ + LONG lDate; + int iYear, iMonth, iDay; + + if( ISNIL( 1 ) ) + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + else + { + lDate = hb_pardl( 1 ); + } + + if( lDate != 0 ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + hb_retd( iYear, 1, 1 ); + } + else + { + hb_retdl( 0 ); + } +} /* $DOC$ @@ -282,12 +387,72 @@ Function BOY( date) * BOM(),EOM(),BOQ(),EOQ(),BOY() * $END$ */ -Function EOY( date) - date := If( ValType( date) == 'D', date, Date()) - if (empty(date)) - return (date) - endif - Return StoD( Str( Year( date), 4, 0) + '1231') + +HB_FUNC( EOY ) +{ + LONG lDate; + int iYear, iMonth, iDay; + + if( ISNIL( 1 ) ) + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + else + { + lDate = hb_pardl( 1 ); + } + + if( lDate != 0 ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + hb_retdl( hb_dateEncode( iYear + 1, 1, 1 ) - 1 ); + } + else + { + hb_retdl( 0 ); + } +} + + +static int hb_wom( int iYear, int iMonth, int iDay ) +{ + int iWom; + + HB_TRACE( HB_TR_DEBUG, ( "hb_wom(%d, %d, %d)", iYear, iMonth, iDay ) ); + + iWom = iDay + hb_dateDOW( iYear, iMonth, 1 ) - 1; + if( iWom > 0 ) + return ( iWom - hb_dateDOW( iYear, iMonth, iDay ) ) / 7 + 1; + else + return 0; +} + +HB_FUNC( WOM ) +{ + LONG lDate; + int iYear, iMonth, iDay; + + if( ISNIL( 1 ) ) + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + else + { + lDate = hb_pardl( 1 ); + } + + if( lDate != 0 ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + hb_retni( hb_wom( iYear, iMonth, iDay ) ); + } + else + { + hb_retni( 0 ); + } +} /* $DOC$ @@ -316,12 +481,11 @@ Function EOY( date) * $SEEALSO$ * $END$ */ -/* this function is allready implemented in RTL */ -/* -Function StoD( cdate) - Local ofd := Set( _SET_DATEFORMAT, 'dd.mm.yyyy'), rvd - cdate := If( ValType( cdate) == 'C', cdate, DtoS( Date())) - rvd := CtoD( SubStr( cDate, 7, 2) + '.' + SubStr( cDate, 5, 2) + '.' + SubStr( cDate, 1, 4)) - Set( _SET_DATEFORMAT, ofd) - Return rvd -*/ + +/* this function is allready implemented in RTL when HB_COMPAT_XPP is set */ +#ifndef HB_COMPAT_XPP +HB_FUNC( STOD ) +{ + hb_retds( hb_parclen( 1 ) >= 7 ? hb_parc( 1 ) : NULL ); +} +#endif diff --git a/harbour/contrib/libct/dattime2.prg b/harbour/contrib/libct/dattime2.c similarity index 56% rename from harbour/contrib/libct/dattime2.prg rename to harbour/contrib/libct/dattime2.c index de40a42514..29ac431c42 100644 --- a/harbour/contrib/libct/dattime2.prg +++ b/harbour/contrib/libct/dattime2.c @@ -1,5 +1,5 @@ /* - * $Id$ + * $Id: dattime2.c,v 1.3 2007/02/13 19:02:24 druzus Exp $ */ /* @@ -19,8 +19,7 @@ * - QUARTER() * - WEEK() * - * Copyright 2002 Alan Secker - * Copyright 2003 Martin Vogel : Enhancements, internationalization, documentation headers + * Copyright 2006 Pavel Tsarenko * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -64,105 +63,53 @@ * */ - -#include "set.ch" -#include "hblang.ch" +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapilng.h" +#include "hbdate.h" +#include "hbset.h" -/* $DOC$ - * $FUNCNAME$ - * ADDMONTH() - * $CATEGORY$ - * CT3 date and time functions - * $ONELINER$ - * add months to a date - * $SYNTAX$ - * ADDMONTH ([,] ) -> dShiftedDate - * $ARGUMENTS$ - * $RETURNS$ - * $DESCRIPTION$ - * TODO: add documentation - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Started - * $COMPLIANCE$ - * ADDMONTH() is compatible with CT3's ADDMOTH(). - * $PLATFORMS$ - * All - * $FILES$ - * Source is dattime2.prg, library is libct. - * $SEEALSO$ - * $END$ - */ +static BOOL ct_isleap( int iYear ) +{ + return ( ( ( iYear & 3 ) == 0 && iYear % 100 != 0 ) || iYear % 400 == 0 ); +} -FUNCTION addmonth ( ddate, nmth ) -local nDay -// local ndays -// local sev -// local dnew -// local dEnd -// local nOldday -local nMonth -local nYear -local nLDOM +static int ct_daysinmonth( int iMonth, BOOL bLeap ) +{ + if( iMonth == 2 ) + { + return ( bLeap ? 29 : 28 ); + } + else if( iMonth == 4 || iMonth == 6 || iMonth == 9 || iMonth == 11 ) + { + return ( 30 ); + } + else + { + return ( 31 ); + } +} -// if nmth > 70 -// return ctod (" / / ") -// endif -// -// nOldday := day (ddate) -// ndays := nmth * 30 -// -// dnew := ddate + ndays -// -// nMonth := month ( dnew ) -// nNyear := year ( dnew ) -// -// dEnd := ctod (str (nOldday) + "/" + str(nMonth) + "/" + str (nNyear)) -// -// return dEnd +static int ct_daystomonth( int iMonth, BOOL bLeap ) +{ + int iMonthes[] = { 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 }; - if !(valtype (ddate) $ "DN") - return ctod("") - endif + return ( ( iMonth < 1 && iMonth > 12 ) ? 0 : iMonthes[iMonth - 1] + + ( ( bLeap && iMonth > 2 ) ? 1 : 0 ) ); +} - if valtype (ddate) == "N" - nmth := ddate - ddate := date() - endif +static int ct_doy( LONG lDate ) +{ + int iYear, iMonth, iDay; + LONG lFirst; - nmth = int (nmth) + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + lFirst = hb_dateEncode( iYear, 1, 1 ); + return ( int ) ( lDate - lFirst + 1 ); +} - nDay = day (ddate) - nMonth = month (ddate) - nYear = year (ddate) - nMonth += nmth - - if nMonth <= 0 - do while nMonth <= 0 - nMonth += 12 - nYear-- - enddo - endif - - if nMonth > 12 - do while nMonth > 12 - nMonth -= 12 - nYear++ - enddo - endif - - // correction for different end of months - if nDay > (nLDOM := lastdayom (nMonth)) - nDay := nLDOM - endif - - ddate := stod (strzero (nYear, 4) + strzero (nMonth, 2) + strzero (nDay, 2)) - return (ddate) - - /* $DOC$ * $FUNCNAME$ * CTODOW() @@ -190,43 +137,52 @@ local nLDOM * NTOCDOW() * $END$ */ +HB_FUNC( CTODOW ) +{ + if( ISCHAR( 1 ) ) + { + char *szParam = hb_parc( 1 ), *szDow; + int iDow, iEqual; -FUNCTION ctodow ( cDow ) -//local cWeek := "SUNMONTUEWEDTHUFRISAT " -//local nWk := len (cWeek) -//local cMatch := left (upper ( Alltrim (cDow)), 3) -//local n -//local nDay := 0 -// -// for n = 1 to nWk step 3 -// if RTRIM (substr (cWeek, n, 3)) == cMatch -// nDay := INT (((n-1) / 3) + 1) -// exit -// endif -// next -// -// return nDay + hb_strupr( szParam ); -local nOrdinal := 0 -local bExact + for( iDow = 0; iDow < 7; iDow++ ) + { + szDow = hb_strdup( ( char * ) hb_langDGetItem( HB_LANG_ITEM_BASE_DAY + iDow ) ); + hb_strupr( szDow ); - if valtype (cDow) != "C" - return (0) - endif - - bExact = set (_SET_EXACT, .F.) - cDow = upper (alltrim (cDow)) + if( hb_set.HB_SET_EXACT ) + { + iEqual = ( strlen( szDow ) == strlen( szParam ) ) + && !memcmp( szDow, szParam, strlen( szParam ) ); + } + else + { + iEqual = !memcmp( szDow, szParam, strlen( szParam ) ); + } - do while nOrdinal < 7 - if upper (alltrim (hb_langmessage (HB_LANG_ITEM_BASE_DAY + nOrdinal))) = cDow - set (_SET_EXACT, bExact) - return (nOrdinal+1) - endif - nOrdinal++ - enddo + hb_xfree( szDow ); + if( iEqual ) + { + break; + } + } - set (_SET_EXACT, bExact) - return (0) + if( iDow == 7 ) + { + hb_retni( 0 ); + } + else + { + hb_retnl( iDow + 1 ); + } + + } + else + { + hb_retni( 0 ); + } +} /* $DOC$ @@ -256,160 +212,49 @@ local bExact * NTOCMONTH() * $END$ */ +HB_FUNC( CTOMONTH ) +{ + if( ISCHAR( 1 ) ) + { + char *szParam = hb_parc( 1 ), *szMonth; + int iMonth, iEqual; -FUNCTION ctomonth ( cDom ) -//local cMonth := "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC " -//local nMnth := len (cMonth) -//local cMatch := left (upper ( Alltrim (cDom)), 3) -//local n -//local nDay := 0 + hb_strupr( szParam ); -local nOrdinal := 0 -local bExact + for( iMonth = 1; iMonth <= 12; iMonth++ ) + { + szMonth = hb_strdup( ( char * ) hb_langDGetItem( HB_LANG_ITEM_BASE_MONTH + iMonth - 1 ) ); + hb_strupr( szMonth ); -// for n = 1 to nMnth step 3 -// if RTRIM (substr (cMonth, n, 3)) == cMatch -// nDay := INT (((n-1) / 3) + 1) -// exit -// endif -// next -// -// return nDay + if( hb_set.HB_SET_EXACT ) + { + iEqual = ( strlen( szMonth ) == strlen( szParam ) ) + && !memcmp( szMonth, szParam, strlen( szParam ) ); + } + else + { + iEqual = !memcmp( szMonth, szParam, strlen( szParam ) ); + } - if valtype (cDom) != "C" - return (0) - endif - - bExact = set (_SET_EXACT, .F.) - cDom = upper (alltrim (cDom)) + hb_xfree( szMonth ); + if( iEqual ) + { + break; + } + } - do while nOrdinal < 12 - if upper (alltrim (hb_langmessage (HB_LANG_ITEM_BASE_MONTH + nOrdinal))) = cDom - set (_SET_EXACT, bExact) - return (nOrdinal+1) - endif - nOrdinal++ - enddo + if( iMonth > 12 ) + { + iMonth = 0; + } + hb_retnl( iMonth ); - set (_SET_EXACT, bExact) - return (0) - - -/* $DOC$ - * $FUNCNAME$ - * DAYSINMONTH() - * $CATEGORY$ - * CT3 date and time functions - * $ONELINER$ - * Returns the number of days in month - * $SYNTAX$ - * DAYSINMONTH (, ) -> nDaysInMonth - * $ARGUMENTS$ - * $RETURNS$ - * $DESCRIPTION$ - * TODO: add documentation - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Started - * $COMPLIANCE$ - * DAYSINMONTH() is a new function in Harbour's CT3 library. - * $PLATFORMS$ - * All - * $FILES$ - * Source is dattime2.prg, library is libct. - * $SEEALSO$ - * DAYSTOMONTH() - * $END$ - */ - -FUNCTION daysInmonth ( nMonth, lLeap ) - -local nday := 0 - - do case - case nMonth == 2 - if lLeap == .T. - nday := 29 - else - nday := 28 - endif - - case nMonth == 4 .or. nMonth == 6 .or. ; - nMonth == 9 .or. nMonth == 11 - nday := 30 - otherwise - nday := 31 - endcase - - return nday - -/* $DOC$ - * $FUNCNAME$ - * DAYSTOMONTH() - * $CATEGORY$ - * CT3 date and time functions - * $ONELINER$ - * Total number of days from first of Jan to beginning of nMonth. - * $SYNTAX$ - * DAYSTOMONTH (, ) -> nDaysToMonth - * $ARGUMENTS$ - * $RETURNS$ - * $DESCRIPTION$ - * lLeap is FALSE for a non-leap year but TRUE if it is. If so and nMonth - * is greater than 2, ndays is incremented - * TODO: add further documentation - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Started - * $COMPLIANCE$ - * DAYSTOMONTH() is a new function in Harbour's CT3 library. - * $PLATFORMS$ - * All - * $FILES$ - * Source is dattime2.prg, library is libct. - * $SEEALSO$ - * DAYSINMONTH() - * $END$ - */ - -FUNCTION daystomonth ( nMonth, lLeap ) - -local ndays := 0 - - if valtype(lLeap) != "L" - lLeap := .F. - endif - - do case - case nMonth == 2 - ndays := 31 // + Jan 31 - case nMonth == 3 - ndays := 59 // + Feb 28 - case nMonth == 4 - ndays := 90 // + Mar 31 - case nMonth == 5 - ndays := 120 // + Apr 30 - case nMonth == 6 - ndays := 151 // + May 31 - case nMonth == 7 - ndays := 181 // + Jun 30 - case nMonth == 8 - ndays := 212 // + Jul 31 - case nMonth == 9 - ndays := 243 // + Aug 31 - case nMonth == 10 - ndays := 273 // + Sep 30 - case nMonth == 11 - ndays := 304 // + Oct 31 - case nMonth == 12 - ndays := 334 // + Nov 30 - endcase - - if (lLeap, ndays ++, ) - - return ndays + } + else + { + hb_retni( 0 ); + } +} /* $DOC$ @@ -441,39 +286,234 @@ local ndays := 0 * MDY() * $END$ */ +HB_FUNC( DMY ) +{ + int iYear, iMonth, iDay; + BOOL bMode = FALSE; -FUNCTION dmy ( ddate, lmode ) + if( ISDATE( 1 ) ) + { + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); -//local nMonth := month (dDate) -//local nDay := day (dDate) -//local nYear := year (dDate) -local nMonth, nDay, nYear + hb_dateDecode( hb_itemGetDL( pDate ), &iYear, &iMonth, &iDay ); + } + else + { + hb_dateToday( &iYear, &iMonth, &iDay ); + } -local cPeriod := "" -local cDate -local cMonth + if( ISLOG( 2 ) ) + { + bMode = hb_parl( 2 ); + } -local cYear -local lSetCentury := __SETCENTURY() + if( iMonth >= 1 && iMonth <= 12 ) + { + char *szMonth = ( char * ) hb_langDGetItem( HB_LANG_ITEM_BASE_MONTH + iMonth - 1 ); + int iMonLen = strlen( szMonth ); + int iLen = 0, iBufLen = iMonLen + 10; + char *szMDY = ( char * ) hb_xgrab( iBufLen ); - if valtype (ddate) != "D" - ddate := date () - endif + if( iDay < 10 ) + { + szMDY[iLen] = iDay + 0x30; + iLen++; + } + else + { + snprintf( szMDY + iLen, 3, "%02d", iDay ); + iLen += 2; + } - nMonth := month (ddate) - nDay := day (ddate) - nYear := year (ddate) + if( bMode ) + { + szMDY[iLen] = '.'; + iLen++; + } + szMDY[iLen] = ' '; + iLen++; - cMonth := ntocmonth ( nMonth ) - cYear := str (nYear, iif (lSetCentury, 4, 2)) + hb_strncpy( szMDY + iLen, szMonth, iBufLen - iLen - 1 ); + iLen += iMonLen; + szMDY[iLen] = ' '; + iLen++; - cPeriod := if (lmode == .T., ".", "") + if( hb_set.hb_set_century ) + { + snprintf( szMDY + iLen, 5, "%04d", iYear ); + iLen += 4; + } + else + { + snprintf( szMDY + iLen, 3, "%02d", iYear % 100 ); + iLen += 2; + } + + hb_retclen( szMDY, iLen ); + hb_xfree( szMDY ); + } + else + { + hb_retc( NULL ); + } +} - cDate := ltrim ( str ( nDay )) + cPeriod + " " + cMonth + " " + ; - ltrim ( cYear ) -// ltrim ( str ( nYear )) - return cDate +/* $DOC$ + * $FUNCNAME$ + * MDY() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns the date as a string in Month DD, YY or Month DD, YYYY + * $SYNTAX$ + * MDY ([]) -> cDateString + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * Returns the date as a string in Month DD, YY or Month DD, YYYY + * If dDate is NULL, the system date is used + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * MDY() is compatible with CT3's MDY(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * DMY() + * $END$ + */ +HB_FUNC( MDY ) +{ + int iYear, iMonth, iDay; + + if( ISDATE( 1 ) ) + { + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); + + hb_dateDecode( hb_itemGetDL( pDate ), &iYear, &iMonth, &iDay ); + } + else + { + hb_dateToday( &iYear, &iMonth, &iDay ); + } + + if( iMonth >= 1 && iMonth <= 12 ) + { + char *szMonth = ( char * ) hb_langDGetItem( HB_LANG_ITEM_BASE_MONTH + iMonth - 1 ); + int iLen = strlen( szMonth ); + int iBufLen = iLen + 9; + char *szMDY = ( char * ) hb_xgrab( iBufLen ); + + hb_strncpy( szMDY, szMonth, iBufLen - 1 ); + szMDY[iLen++] = ' '; + if( iDay < 10 ) + { + szMDY[iLen] = iDay + 0x30; + iLen++; + } + else + { + snprintf( szMDY + iLen, 3, "%02d", iDay ); + iLen += 2; + } + szMDY[iLen++] = ' '; + + if( hb_set.hb_set_century ) + { + snprintf( szMDY + iLen, 5, "%04d", iYear ); + iLen += 4; + } + else + { + snprintf( szMDY + iLen, 3, "%02d", iYear % 100 ); + iLen += 2; + } + + hb_retclen( szMDY, iLen ); + hb_xfree( szMDY ); + } + else + { + hb_retc( NULL ); + } +} + + +/* $DOC$ + * $FUNCNAME$ + * ADDMONTH() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * add months to a date + * $SYNTAX$ + * ADDMONTH ([,] ) -> dShiftedDate + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * ADDMONTH() is compatible with CT3's ADDMOTH(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC( ADDMONTH ) +{ + int iYear, iMonth, iDay, iNum, iDays; + + if( ISDATE( 1 ) ) + { + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); + + hb_dateDecode( hb_itemGetDL( pDate ), &iYear, &iMonth, &iDay ); + iNum = hb_parni( 2 ); + } + else if( ISNUM( 1 ) ) + { + iNum = hb_parni( 1 ); + hb_dateToday( &iYear, &iMonth, &iDay ); + } + else + { + hb_retdl( 0 ); + return; + } + + iMonth += iNum; + while( iMonth <= 0 ) + { + iMonth += 12; + iYear--; + } + while( iMonth > 12 ) + { + iMonth -= 12; + iYear++; + } + + iDays = ct_daysinmonth( iMonth, ct_isleap( iYear ) ); + if( iDay > iDays ) + { + iDay = iDays; + } + + hb_retd( iYear, iMonth, iDay ); +} /* $DOC$ @@ -504,26 +544,25 @@ local lSetCentury := __SETCENTURY() * $SEEALSO$ * $END$ */ +HB_FUNC( DOY ) +{ + LONG lDate; + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); -FUNCTION doy ( dDate ) + if( pDate ) + { + lDate = hb_itemGetDL( pDate ); + } + else + { + int iYear, iMonth, iDay; -local lleap := .F. -local nMonth := month (dDate) -local nDay := day (dDate) -local numdays := 0 + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } - if valtype ( dDate ) != "D" - dDate := date() - endif - - if empty (dDate) - return 0 - endif - - lLeap := isleap (dDate) - numdays := daystomonth ( nMonth, lleap ) + nDay - - return numdays + hb_retni( ct_doy( lDate ) ); +} /* $DOC$ @@ -552,171 +591,71 @@ local numdays := 0 * $SEEALSO$ * $END$ */ - -FUNCTION isleap ( ddate ) +HB_FUNC( ISLEAP ) +{ + int iYear, iMonth, iDay; + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); -local nYear -local nMmyr -local nCyYr -local nQdYr -local lRetval + if( pDate && hb_itemGetDL( pDate ) ) + { + hb_dateDecode( hb_itemGetDL( pDate ), &iYear, &iMonth, &iDay ); + } + else + { + hb_dateToday( &iYear, &iMonth, &iDay ); + } - if empty ( ddate ) - ddate := date () - endif + hb_retl( ct_isleap( iYear ) ); +} - nYear := year (ddate) - nCyYr := nYear / 400 -// nMmyr := nyear /1000 - nMmyr := nYear /100 - nQdYr := nYear / 4 - - do case - case int (nCyYr) == nCyYr - lRetVal := .T. - case int (nMmyr) == nMmyr - lRetVal := .F. - - case int (nQdYr) == nQdYr - lRetVal := .T. - - otherwise - lRetVal := .F. - endcase - - return lRetVal - /* $DOC$ * $FUNCNAME$ - * LASTDAYOM() + * DAYSTOMONTH() * $CATEGORY$ * CT3 date and time functions * $ONELINER$ - * Returns the the number of days in the month. + * Total number of days from first of Jan to beginning of nMonth. * $SYNTAX$ - * LASTDAYOM ([]) -> nDaysInMonth + * DAYSTOMONTH (, ) -> nDaysToMonth * $ARGUMENTS$ * $RETURNS$ * $DESCRIPTION$ - * can be a date or a month number. If empty uses the - * system date. If nMonth is a 2, lastdayom() will not know if it - * is a leap year or not. If dDate is invalid, returns 0 + * lLeap is FALSE for a non-leap year but TRUE if it is. If so and nMonth + * is greater than 2, ndays is incremented * TODO: add further documentation * $EXAMPLES$ * $TESTS$ * $STATUS$ * Started * $COMPLIANCE$ - * LASTDAYOM() is compatible with CT3's LASTDAYOM(). + * DAYSTOMONTH() is a new function in Harbour's CT3 library. * $PLATFORMS$ * All * $FILES$ * Source is dattime2.prg, library is libct. * $SEEALSO$ - * EOM() + * DAYSINMONTH() * $END$ */ +HB_FUNC( DAYSTOMONTH ) +{ + int iMonth = ( ISNUM( 1 ) ? hb_parni( 1 ) : 0 ); + BOOL bLeap = ( ISLOG( 2 ) ? hb_parl( 2 ) : 0 ); -FUNCTION lastdayom ( xDate ) - -local nMonth := 0 -local nDays := 0 -local lleap := .F. - - do case - case empty ( xDate) - nMonth := month ( date() ) - - case valtype ( xDate ) == "D" - nMonth := month (xdate) - lleap := isleap ( xdate) - - case valtype (xDate ) == "N" - if xdate > 12 - nmonth := 0 - else - nMonth := xDate - endif - endcase - - if nmonth != 0 - ndays := daysInmonth ( nMonth, lleap ) - endif - - return ndays - - -/* $DOC$ - * $FUNCNAME$ - * MDY() - * $CATEGORY$ - * CT3 date and time functions - * $ONELINER$ - * Returns the date as a string in Month DD, YY or Month DD, YYYY - * $SYNTAX$ - * MDY ([]) -> cDateString - * $ARGUMENTS$ - * $RETURNS$ - * $DESCRIPTION$ - * Returns the date as a string in Month DD, YY or Month DD, YYYY - * If dDate is NULL, the system date is used - * TODO: add further documentation - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Started - * $COMPLIANCE$ - * MDY() is compatible with CT3's MDY(). - * $PLATFORMS$ - * All - * $FILES$ - * Source is dattime2.prg, library is libct. - * $SEEALSO$ - * DMY() - * $END$ - */ - -FUNCTION mdy ( dDate ) - -local nMonth -local nDay -local nYear -local cDate -local cMonth - -local lSetCentury := __SETCENTURY() -local cYear - -// default dDate to date() - if valtype (ddate) != "D" - ddate := date () - endif - - nMonth := month (dDate) - nDay := day (dDate) - nYear := year (dDate) - cMonth := ntocmonth ( nMonth ) - - cYear := str (nYear, iif (lSetCentury, 4, 2)) - - cDate := cMonth + " " + ; - ltrim ( str ( nDay )) + " " + ; - ltrim ( cYear ) - // ltrim ( str ( nYear )) - - return cDate + hb_retni( ct_daystomonth( iMonth, bLeap ) ); +} /* $DOC$ * $FUNCNAME$ - * NTOCDOW() + * DAYSINMONTH() * $CATEGORY$ * CT3 date and time functions * $ONELINER$ - * (num of day) -> day name + * Returns the number of days in month * $SYNTAX$ - * NTOCDOW () -> cDay + * DAYSINMONTH (, ) -> nDaysInMonth * $ARGUMENTS$ * $RETURNS$ * $DESCRIPTION$ @@ -726,91 +665,23 @@ local cYear * $STATUS$ * Started * $COMPLIANCE$ - * NTOCDOW() is compatible with CT3's NTOCDOW(). + * DAYSINMONTH() is a new function in Harbour's CT3 library. * $PLATFORMS$ * All * $FILES$ * Source is dattime2.prg, library is libct. * $SEEALSO$ - * CTODOW() + * DAYSTOMONTH() * $END$ */ +HB_FUNC( DAYSINMONTH ) +{ + int iMonth = ( ISNUM( 1 ) ? hb_parni( 1 ) : 0 ); + BOOL bLeap = ( ISLOG( 2 ) ? hb_parl( 2 ) : 0 ); -FUNCTION ntocdow ( nDay ) - -local cDay := "" - - if nDay >= 1 .AND. nDay <= 7 - cDay := hb_langmessage (HB_LANG_ITEM_BASE_DAY + (nDay-1)) - endif + hb_retni( ct_daysinmonth( iMonth, bLeap ) ); - return cDay - - -/* $DOC$ - * $FUNCNAME$ - * NTOCMONTH() - * $CATEGORY$ - * CT3 date and time functions - * $ONELINER$ - * (num of month ) -> Month Name - * $SYNTAX$ - * NTOCMONTH () -> cMonth - * $ARGUMENTS$ - * $RETURNS$ - * $DESCRIPTION$ - * TODO: add documentation - * $EXAMPLES$ - * $TESTS$ - * $STATUS$ - * Started - * $COMPLIANCE$ - * NTOCMONTH() is compatible with CT3's NTOCMONTH(). - * $PLATFORMS$ - * All - * $FILES$ - * Source is dattime2.prg, library is libct. - * $SEEALSO$ - * CTOMONTH() - * $END$ - */ - -FUNCTION ntocmonth ( nMonthNum ) - -local cMonth := "" - - if nMonthNum >= 1 .AND. nMonthNum <= 12 - cMonth := hb_langmessage (HB_LANG_ITEM_BASE_MONTH + (nMonthNum-1)) - endif - -// do case -// case nMonthNum == 1 -// cMonth := "January" -// case nMonthNum == 2 -// cMonth := "February" -// case nMonthNum == 3 -// cMonth := "March" -// case nMonthNum == 4 -// cMonth := "April" -// case nMonthNum == 5 -// cMonth := "May" -// case nMonthNum == 6 -// cMonth := "June" -// case nMonthNum == 7 -// cMonth := "July" -// case nMonthNum == 8 -// cMonth := "August" -// case nMonthNum == 9 -// cMonth := "September" -// case nMonthNum == 10 -// cMonth := "October" -// case nMonthNum == 11 -// cMonth := "November" -// case nMonthNum == 12 -// cMonth := "December" -// endcase - - return cMonth +} /* $DOC$ @@ -841,22 +712,160 @@ local cMonth := "" * $SEEALSO$ * $END$ */ +HB_FUNC( QUARTER ) +{ + int iYear, iMonth, iDay; + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); -FUNCTION quarter ( ddate ) + if( pDate ) + { + if( hb_itemGetDL( pDate ) ) + { + hb_dateDecode( hb_itemGetDL( pDate ), &iYear, &iMonth, &iDay ); + } + else + { + hb_retni( 0 ); + return; + } + } + else + { + hb_dateToday( &iYear, &iMonth, &iDay ); + } -local nmonth -local nretmonth + hb_retni( ( iMonth + 2 ) / 3 ); +} - if empty (ddate) - ddate := date() - endif - nmonth := month (ddate) -// nretmonth := int (( nmonth / 3 ) + 0.67 ) - nretmonth := int ((nmonth + 2) / 3 ) +/* $DOC$ + * $FUNCNAME$ + * LASTDAYOM() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns the the number of days in the month. + * $SYNTAX$ + * LASTDAYOM ([]) -> nDaysInMonth + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * can be a date or a month number. If empty uses the + * system date. If nMonth is a 2, lastdayom() will not know if it + * is a leap year or not. If dDate is invalid, returns 0 + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * LASTDAYOM() is compatible with CT3's LASTDAYOM(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * EOM() + * $END$ + */ +HB_FUNC( LASTDAYOM ) +{ + BOOL bLeap = 0; + int iYear, iMonth, iDay; - return nretmonth + if( ISDATE( 1 ) ) + { + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); + LONG lDate = hb_itemGetDL( pDate ); + if( lDate ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + } + else + { + hb_dateToday( &iYear, &iMonth, &iDay ); + } + bLeap = ct_isleap( iYear ); + } + else if( ISNUM( 1 ) ) + { + iMonth = hb_parni( 1 ); + } + else + { + iMonth = 0; + } + + hb_retni( ( iMonth && ( iMonth <= 12 ) ? ct_daysinmonth( iMonth, bLeap ) : 0 ) ); + +} + + +/* $DOC$ + * $FUNCNAME$ + * NTOCDOW() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * (num of day) -> day name + * $SYNTAX$ + * NTOCDOW () -> cDay + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * NTOCDOW() is compatible with CT3's NTOCDOW(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * CTODOW() + * $END$ + */ +HB_FUNC( NTOCDOW ) +{ + hb_retc( hb_dateCDOW( hb_parni( 1 ) ) ); +} + + +/* $DOC$ + * $FUNCNAME$ + * NTOCMONTH() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * (num of month ) -> Month Name + * $SYNTAX$ + * NTOCMONTH () -> cMonth + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * NTOCMONTH() is compatible with CT3's NTOCMONTH(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * CTOMONTH() + * $END$ + */ +HB_FUNC( NTOCMONTH ) +{ + hb_retc( hb_dateCMonth( hb_parni( 1 ) ) ); +} /* $DOC$ @@ -895,65 +904,48 @@ local nretmonth * $SEEALSO$ * $END$ */ +HB_FUNC( WEEK ) +{ + int iYear, iMonth, iDay, iWeek; + PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); + LONG lDate = 0; + BOOL bSWN = ( ISLOG( 2 ) ? hb_parl( 2 ) : 0 ); -FUNCTION week ( dDate, lSWN ) - -local nMonth -local nDays -local nDay -local nYear -local nWeek -local nPart -local dDate2 -// local nleap - -// do case -// case valtype (dDate) == "D" .and. empty ( dDate) -// return nDays -// -// case empty (dDate) -// dDate := date() -// endcase - - if valtype (dDate) == "D" .and. empty (dDate) - return 0 - endif - - if empty (dDate) - dDate := date() - endif - - nMonth := month (dDate) - nDay := day (dDate) - nYear := year (dDate) - - if valtype (lSWN) != "L" - lSWN := .F. - endif - - if lSWN - // simple week number - - // nleap := if (isleap (dDate), 1, nleap) - // ndays := daystomonth ( nMonth, nleap ) + nday - nDays := daystomonth ( nMonth, isleap (dDate)) + nDay - - nPart := nDays % 7 - nWeek := INT (nDays / 7) - - nWeek := INT (if ( nPart > 0, ++ nWeek, nWeek)) - - else - // ISO8601 week number - dDate2 := dDate + 3 - ((dow(dDate)+5) % 7) - nWeek := 1 + int ((dDate2 - boy (dDate2)) / 7) - - endif - - return nWeek - + if( ISDATE( 1 ) ) + { + lDate = hb_itemGetDL( pDate ); + if( !lDate ) + { + hb_retni( 0 ); + return; + } + } + if( lDate ) + { + hb_dateDecode( lDate, &iYear, &iMonth, &iDay ); + } + else + { + hb_dateToday( &iYear, &iMonth, &iDay ); + lDate = hb_dateEncode( iYear, iMonth, iDay ); + } + if( bSWN ) + { + int iDays = ct_daystomonth( iMonth, ct_isleap( iYear ) ) + iDay; + int iPart = ( iDays % 7 ); + iWeek = iDays / 7; + if( iPart > 0 ) + iWeek++; + } + else + { + LONG lDate2 = lDate + 3 - ( ( hb_dateDOW( iYear, iMonth, iDay ) + 5 ) % 7 ); + iWeek = ( ct_doy( lDate2 ) - 1 ) / 7 + 1; + } + hb_retni( iWeek ); +} diff --git a/harbour/contrib/libct/dbftools.c b/harbour/contrib/libct/dbftools.c new file mode 100644 index 0000000000..5e1dbfe753 --- /dev/null +++ b/harbour/contrib/libct/dbftools.c @@ -0,0 +1,102 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Some dbf structure related functions + * + * Copyright 2000 Alexander Kresin + * 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 "hbapirdd.h" + +HB_FUNC_EXTERN( FIELDPOS ); +HB_FUNC_EXTERN( FIELDLEN ); +HB_FUNC_EXTERN( FIELDDEC ); + +HB_FUNC( FIELDSIZE ) +{ + HB_FUNC_EXEC( FIELDLEN ); +} + +HB_FUNC( FIELDDECI ) +{ + HB_FUNC_EXEC( FIELDDEC ); +} + +HB_FUNC( FIELDNUM ) +{ + HB_FUNC_EXEC( FIELDPOS ); +} + +HB_FUNC( DBFSIZE ) +{ + HB_LONG llSize = 0; + AREAP pArea; + + if( ( pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer() ) != NULL ) + { + PHB_ITEM pSize = hb_itemNew( NULL ); + ULONG ulRecSize, ulRecCount; + + if( SELF_INFO( pArea, DBI_GETHEADERSIZE, pSize ) == SUCCESS ) + { + llSize = hb_itemGetNL( pSize ) + 1; + if( SELF_INFO( pArea, DBI_GETRECSIZE, pSize ) == SUCCESS ) + { + ulRecSize = hb_itemGetNL( pSize ); + if( SELF_RECCOUNT( pArea, &ulRecCount ) == SUCCESS ) + { + llSize += ( HB_LONG ) ulRecCount *ulRecSize; + } + } + } + hb_itemRelease( pSize ); + } + + hb_retnint( llSize ); +} diff --git a/harbour/contrib/libct/disk.c b/harbour/contrib/libct/disk.c new file mode 100644 index 0000000000..81a06e01f2 --- /dev/null +++ b/harbour/contrib/libct/disk.c @@ -0,0 +1,365 @@ +/* + * $Id$ + */ +/* + * xHarbour Project source code: + * CT (Clipper Tools) Disk, File and Directory management. + * + * Copyright 2004-2005 Eduardo Fernandes + * + * DeleteFile() - Ready. Source is in "disk.c" + * DirMake() - Ready. Already exist a MakeDir() function in xHarbour RTL Lib, + * but DirMake returns a more compatible error codes. + * DirName() - Ready. + * DriveType() - Ready. corrected + * FileMove() - Ready. + * Volume() - Ready. + * GetVolInfo() - Ready. This function is new. + * VolSerial() - Ready. + * + * Copyright 2004 Phil Krylov + * NUMDISKL() + * + * Copyright 2006 Pavel Tsarenko + * TrueName() + * + * www - http://www.xharbour.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or ( at your option ) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA ( or visit the web site http://www.gnu.org/ ). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "hbapi.h" +#include "hbapierr.h" +#include "hbapifs.h" +#include "ctstrfil.h" + +#if defined(HB_OS_WIN_32) + +# include +# include +# include + +# define HB_OS_WIN_32_USED + +#elif defined(HB_OS_DOS) + +# include + +#endif + + +HB_FUNC( DELETEFILE ) +{ + BYTE *pFileName = ( BYTE * ) hb_parcx( 1 ); + + if( hb_fsDelete( pFileName ) ) + { + hb_retni( 0 ); + } + else + { + hb_retni( -hb_fsOsError() ); + } +} + +HB_FUNC( DIRMAKE ) +{ + BYTE *pFileName = ( BYTE * ) hb_parcx( 1 ); + + if( hb_fsMkDir( pFileName ) ) + { + hb_retni( 0 ); + } + else + { + hb_retni( -hb_fsOsError() ); + } +} + +HB_FUNC( DIRNAME ) +{ + BYTE *pbyBuffer = ( BYTE * ) hb_xgrab( _POSIX_PATH_MAX + 1 ); + + pbyBuffer[0] = OS_PATH_DELIMITER; + hb_fsCurDirBuff( hb_fsCurDrv(), pbyBuffer + 1, _POSIX_PATH_MAX ); + + hb_retc_buffer( ( char * ) pbyBuffer ); +} + + +HB_FUNC( DRIVETYPE ) +{ +#if defined(HB_OS_WIN_32) + unsigned int uiType; + ULONG ulSize = hb_parclen( 1 ) + 2; /* allow space for '\0' & ":\" */ + char *pDrive = ( char * ) hb_xgrab( ulSize + 1 ); + + hb_strncpy( pDrive, ( char * ) hb_parcx( 1 ), ulSize ); + + if( strstr( pDrive, ":" ) == NULL ) + { + hb_strncat( pDrive, ":", ulSize ); + } + + if( strstr( pDrive, "\\" ) == NULL ) + { + hb_strncat( pDrive, "\\", ulSize ); + } + + uiType = GetDriveType( pDrive ); + + if( uiType == DRIVE_RAMDISK ) + { + hb_retni( 0 ); /* RAM Drive - Clipper compatible */ + } + else if( uiType == DRIVE_REMOVABLE ) + { + hb_retni( 2 ); /* Floppy Drive - Clipper compatible */ + } + else if( uiType == DRIVE_FIXED ) + { + hb_retni( 3 ); /* Hard Drive - Clipper compatible */ + } + else if( uiType == DRIVE_CDROM ) + { + hb_retni( 4 ); /* CD-Rom Drive - xHarbour extension */ + } + else if( uiType == DRIVE_REMOTE ) + { + hb_retni( 5 ); /* Network Drive - xHarbour extension */ + } + else + { + hb_retni( 9 ); /* Unknow Drive - xHarbour extension */ + } + hb_xfree( pDrive ); +#else + hb_retni( 9 ); +#endif + +} + +HB_FUNC( FILEMOVE ) +{ + BYTE *pSourceFile = ( BYTE * ) hb_parcx( 1 ); + BYTE *pTargetFile = ( BYTE * ) hb_parcx( 2 ); + + if( hb_fsRename( pSourceFile, pTargetFile ) ) + { + hb_retni( 0 ); + } + else + { + hb_retni( -hb_fsOsError() ); + } +} + + +HB_FUNC( NUMDISKL ) +{ +#if defined( HB_OS_DOS ) +#if defined( __DJGPP__ ) + unsigned cur_drive, n_drives; + + _dos_getdrive( &cur_drive ); + _dos_setdrive( cur_drive, &n_drives ); + hb_retni( n_drives ); +#else + /* should be easily implementable somehow similar to DJGPP */ + hb_retni( 26 ); +#endif +#elif defined( HB_OS_WIN_32 ) + /* LASTDRIVE does not affect Win32 apps, they always have 26 letters avail */ + hb_retni( 26 ); +#else + /* For Unix, return the most harmless value... or not? */ + hb_retni( 1 ); +#endif +} + + +/* + * Volume() depends of the CSETSAFETY() setting and, if is true, does not + * overwrite an existing label. + * + * Syntax is: Volume("x:test") or Volume("x:\test"), where "x" is the + * any drive letter and "test" will be the new volume name. + * + * Notes: + * 1) if the drive letter is not suplied, then the current drive will + * be used to change voloume name. + * 2) if Volume("x:") or Volume("x:\") then the volume name of the drive + * "x:" will be erased. + * 3) if Volume("") or Volume() then the volume name of the current drive + * will be erased. + */ + +HB_FUNC( VOLUME ) +{ + BOOL bReturn = FALSE; + + if( !ct_getsafety() ) + { + PHB_FNAME fname; + BYTE *sDiskName; + char *sRoot = NULL; + char *sVolName = NULL; + char sRootBuf[3], sVolNameBuf[12]; + + if( ISCHAR( 1 ) && hb_parclen( 1 ) > 0 ) + { + sDiskName = hb_fileNameConv( hb_strdup( hb_parcx( 1 ) ) ); + + if( ( fname = hb_fsFNameSplit( ( char * ) sDiskName ) ) != NULL ) + { + if( fname->szPath ) + { + strncpy( sRootBuf, fname->szPath, 3 ); + sRoot = sRootBuf; + } + if( fname->szName ) + { + strncpy( sVolNameBuf, fname->szName, 11 ); + sVolName = sVolNameBuf; + } + + hb_xfree( fname ); + } + else + { + strncpy( sVolNameBuf, ( char * ) sDiskName, 11 ); + sVolName = sVolNameBuf; + } + } +#if defined(HB_OS_WIN_32) + bReturn = SetVolumeLabel( sRoot, sVolName ); +#endif + } + hb_retl( bReturn ); +} + +/* + * GetVolInfo() is a new function. It returns the volume name of a Floppy, CD, + * Hard-disk or mapped network drive. + * Sintax is: GetVolInfo("x:\") + * Note that the trailing backslash is required. + */ +HB_FUNC( GETVOLINFO ) +{ +#if defined(HB_OS_WIN_32) + int iretval; + char *sDrive = hb_parcx( 1 ); + char sVolName[255]; + + if( sDrive[0] == 0 ) + { + sDrive = NULL; + } + iretval = GetVolumeInformation( sDrive, sVolName, 256, NULL, NULL, NULL, NULL, 0 ); + + if( iretval != 0 ) + hb_retc( sVolName ); + else + hb_retc( NULL ); +#endif +} + +/* + * VolSerial() function returns the volume serial number of an drive letter like + * floppy, Hard-disk, CD or mapped network drive. The return value is a dword + * type. If the drive is not available, volserial() returns -1. + * + * Sintax is: VolSerial("x:\") + * Note that the trailing backslash is required. + * + * To convert in the hex format, call numtohex() function. + * Example: numtohex( volserial("c:\")). + * See volser.prg in xharbour\tests\cttest folder. + */ + +HB_FUNC( VOLSERIAL ) +{ +#if defined(HB_OS_WIN_32) + int retval; + char *sDrive = hb_parcx( 1 ); + DWORD dSerial; + + if( sDrive[0] == 0 ) + { + sDrive = NULL; + } + retval = GetVolumeInformation( sDrive, /* RootPathName */ + NULL, /* VolumeName */ + 0, /* VolumeNameSize */ + &dSerial, /* VolumeSerialNumber */ + NULL, /* MaxComponentLength */ + NULL, /* FileSystemFlags */ + NULL, /* FileSystemName */ + 0 ); /* FileSystemSize */ + + if( retval != 0 ) + hb_retnd( dSerial ); + else + hb_retni( -1 ); +#endif +} + +HB_FUNC( TRUENAME ) +{ + if( ISCHAR( 1 ) ) + { + char *szFile = hb_parc( 1 ); + +#ifdef HB_OS_WIN_32 + char *szBuffRet = NULL; + char buffer[MAX_PATH + 1] = { 0 }; + + GetFullPathName( ( LPCSTR ) szFile, MAX_PATH, ( LPSTR ) buffer, &szBuffRet ); + hb_retc( buffer ); +#else + hb_retc( szFile ); +#endif + } + else + { + hb_retc( NULL ); + } +} diff --git a/harbour/contrib/libct/exponent.c b/harbour/contrib/libct/exponent.c index 6969b2734d..0380994c51 100644 --- a/harbour/contrib/libct/exponent.c +++ b/harbour/contrib/libct/exponent.c @@ -101,46 +101,46 @@ HB_FUNC( MANTISSA ) #ifdef CT_EXPONENT_MANTISSA_BIT - union - { - double value; - char string[ sizeof( double )]; - } xConvert; + union + { + double value; + char string[sizeof( double )]; + } xConvert; - xConvert.value = hb_parnd( 1 ); + xConvert.value = hb_parnd( 1 ); - if( xConvert.value != 0 ) - { - xConvert.string[6] |= 0xF0; - xConvert.string[7] |= 0x3F; - xConvert.string[7] &= 0xBF; - } + if( xConvert.value != 0 ) + { + xConvert.string[6] |= 0xF0; + xConvert.string[7] |= 0x3F; + xConvert.string[7] &= 0xBF; + } - hb_retnd( xConvert.value ); + hb_retnd( xConvert.value ); #else - double dValue; + double dValue; - dValue = hb_parnd( 1 ); + dValue = hb_parnd( 1 ); - if (dValue == 0.0) - { - hb_retnd( 0.0 ); - return; - } + if( dValue == 0.0 ) + { + hb_retnd( 0.0 ); + return; + } - if (fabs(dValue)<1.0) - { - while (fabs(dValue)<1.0) - dValue *= 2.0; - } - else if (fabs(dValue)>=2.0) - { - while (fabs(dValue)>=2.0) - dValue /= 2.0; - } - hb_retnd( dValue ); + if( fabs( dValue ) < 1.0 ) + { + while( fabs( dValue ) < 1.0 ) + dValue *= 2.0; + } + else if( fabs( dValue ) >= 2.0 ) + { + while( fabs( dValue ) >= 2.0 ) + dValue /= 2.0; + } + hb_retnd( dValue ); #endif @@ -197,58 +197,57 @@ HB_FUNC( EXPONENT ) #ifdef CT_EXPONENT_MANTISSA_BIT - int iExponent = 0; + int iExponent = 0; - union - { - double value; - char string[ sizeof( double )]; - } xConvert; + union + { + double value; + char string[sizeof( double )]; + } xConvert; - xConvert.value = hb_parnd( 1 ); + xConvert.value = hb_parnd( 1 ); - if( xConvert.value != 0 ) - { - iExponent = ( int ) ( xConvert.string[7] & 0x07F ); - iExponent = iExponent << 4; - iExponent += ( int ) ( ( xConvert.string[6] & 0xF0 ) >> 4 ); - iExponent -= 1023; - } + if( xConvert.value != 0 ) + { + iExponent = ( int ) ( xConvert.string[7] & 0x07F ); + iExponent = iExponent << 4; + iExponent += ( int ) ( ( xConvert.string[6] & 0xF0 ) >> 4 ); + iExponent -= 1023; + } - hb_retni( iExponent ); + hb_retni( iExponent ); #else - int iExponent = 0; - double dValue; + int iExponent = 0; + double dValue; - dValue = hb_parnd( 1 ); + dValue = hb_parnd( 1 ); - if (dValue == 0.0) - { - hb_retni( 0 ); - return; - } + if( dValue == 0.0 ) + { + hb_retni( 0 ); + return; + } - if( fabs( dValue ) < 1.0 ) - { - while ( fabs( dValue ) < 1.0 ) - { - dValue *= 2.0; - iExponent--; - } - } - else if ( fabs( dValue ) >= 2.0 ) - { - while ( fabs( dValue ) >= 2.0 ) - { - dValue /= 2.0; - iExponent++; - } - } - hb_retni( iExponent ); + if( fabs( dValue ) < 1.0 ) + { + while( fabs( dValue ) < 1.0 ) + { + dValue *= 2.0; + iExponent--; + } + } + else if( fabs( dValue ) >= 2.0 ) + { + while( fabs( dValue ) >= 2.0 ) + { + dValue /= 2.0; + iExponent++; + } + } + hb_retni( iExponent ); #endif } -