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

2007-07-07 04:00 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
+ 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
This commit is contained in:
Przemyslaw Czerpak
2007-07-07 02:00:32 +00:00
parent 94cf099be5
commit 5f2c757781
14 changed files with 1911 additions and 848 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
harbour/ChangeLog
View File

@@ -8,6 +8,27 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
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

10
harbour/contrib/libct/Makefile
View File

@@ -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

38
harbour/contrib/libct/ct.h
View File

@@ -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

4
harbour/contrib/libct/ctmath.h
View File

@@ -62,6 +62,8 @@
#include <float.h>
#include <limits.h>
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 */

170
harbour/contrib/libct/pad.c → harbour/contrib/libct/ctpad.c
View File

@@ -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 );
}

4
harbour/contrib/libct/ctstr.h
View File

@@ -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

268
harbour/contrib/libct/ctstrfil.c Normal file
View File

@@ -0,0 +1,268 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* Functions:
* SETFCREATE(), CSETSAFETY(), STRFILE(), FILESTR(), SCREENFILE()
* SCREENFILE(), FILESCREEN()
*
* Copyright 2004 Pavel Tsarenko <tpe2@mail.ru>
* 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 );
}
}

63
harbour/contrib/libct/ctstrfil.h Normal file
View File

@@ -0,0 +1,63 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Header file for Clipper Tools like window system
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* 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_ */

99
harbour/contrib/libct/cttime.prg Normal file
View File

@@ -0,0 +1,99 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* TIMETOSEC(), SECTOTIME(), MILLISEC()
*
* Copyright 2003 Piero Vincenzo Lupano <pierovincenzo1956@supereva.it>
* Copyright 2003 Przemyslaw Czerpak <druzus@acn.waw.pl>
* 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 ""

310
harbour/contrib/libct/datetime.prg → harbour/contrib/libct/datetime.c
View File

@@ -7,9 +7,9 @@
* CT3 Date & Time functions: - BOM() / EOM()
* - BOQ() / EOQ()
* - BOY() / EOY()
* - STOD()
* - WOM()
*
* Copyright 1999-2001 Marek Horodyski <homar@altkom.com.pl>
* Copyright 2005 Pavel Tsarenko <tpe2@mail.ru>
* 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 <dezac@corevia.com>
* 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

1162
harbour/contrib/libct/dattime2.prg → harbour/contrib/libct/dattime2.c
View File

File diff suppressed because it is too large Load Diff

102
harbour/contrib/libct/dbftools.c Normal file
View File

@@ -0,0 +1,102 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Some dbf structure related functions
*
* Copyright 2000 Alexander Kresin <alex@belacy.belgorod.su>
* 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 );
}

365
harbour/contrib/libct/disk.c Normal file
View File

@@ -0,0 +1,365 @@
/*
* $Id$
*/
/*
* xHarbour Project source code:
* CT (Clipper Tools) Disk, File and Directory management.
*
* Copyright 2004-2005 Eduardo Fernandes <modalsist@yahoo.com.br>
*
* 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 <ptucker@sympatico.ca>
* FileMove() - Ready.
* Volume() - Ready.
* GetVolInfo() - Ready. This function is new.
* VolSerial() - Ready.
*
* Copyright 2004 Phil Krylov <phil@newstar.rinet.ru>
* NUMDISKL()
*
* Copyright 2006 Pavel Tsarenko <tpe2@mail.ru>
* 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 <windows.h>
# include <winbase.h>
# include <shellapi.h>
# define HB_OS_WIN_32_USED
#elif defined(HB_OS_DOS)
# include <dos.h>
#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 );
}
}

143
harbour/contrib/libct/exponent.c
View File

@@ -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
}