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

2009-01-26 21:25 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/source/common/hbprintf.c
  * harbour/source/codepage/cpeswinm.c
  * harbour/source/rdd/usrrdd/example/exlog.prg
  * harbour/source/rdd/usrrdd/rdds/logrdd.prg
  * harbour/contrib/xhb/dbgfx.prg
  * harbour/contrib/xhb/xhb.h
  * harbour/contrib/xhb/sprintf.prg
  * harbour/contrib/xhb/dbgfxc.c
  * harbour/contrib/xhb/hbstruct.prg
  * harbour/contrib/xhb/hbstruct.ch
  * harbour/contrib/hbmsql/tests/hbmk_b32.bat
  * harbour/contrib/hbmsql/tests/hbmk_vc.bat
    ! fixed hardcoded CRLF and svn:eol-style attribute
This commit is contained in:
Przemyslaw Czerpak
2009-01-26 20:21:57 +00:00
parent c3242c1e02
commit fe43de6002
10 changed files with 2416 additions and 2401 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
harbour/ChangeLog
View File

@@ -8,6 +8,21 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2009-01-26 21:25 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/common/hbprintf.c
* harbour/source/codepage/cpeswinm.c
* harbour/source/rdd/usrrdd/example/exlog.prg
* harbour/source/rdd/usrrdd/rdds/logrdd.prg
* harbour/contrib/xhb/dbgfx.prg
* harbour/contrib/xhb/xhb.h
* harbour/contrib/xhb/sprintf.prg
* harbour/contrib/xhb/dbgfxc.c
* harbour/contrib/xhb/hbstruct.prg
* harbour/contrib/xhb/hbstruct.ch
* harbour/contrib/hbmsql/tests/hbmk_b32.bat
* harbour/contrib/hbmsql/tests/hbmk_vc.bat
! fixed hardcoded CRLF and svn:eol-style attribute
2009-01-26 21:18 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* source/common/hbprintf.c
! Some fixes to make it compile under BCC.

236
harbour/contrib/xhb/dbgfx.prg
View File

@@ -1,118 +1,118 @@
/*
* $Id: dbgfx.prg 9738 2008-10-26 07:10:19Z vszakats $
*/
/*
* Harbour Project source code:
* Debug Functions
*
* Copyright 2007-2008 Francesco Saverio Giudice <info / at /fsgiudice.com>
* 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 "common.ch"
#include "fileio.ch"
STATIC s_lToOutDebug := .T.
STATIC s_lToLogFile := .T.
STATIC s_lEmptyLogFile := .T.
FUNCTION HB_ToOutDebugOnOff( lOnOff )
LOCAL lOld := s_lToOutDebug
IF hb_isLogical( lOnOff )
s_lToOutDebug := lOnOff
ENDIF
RETURN lOld
PROCEDURE HB_ToOutDebug( ... )
IF s_lToOutDebug
hb_OutDebug( hb_sprintf( ... ) )
ENDIF
RETURN
FUNCTION HB_ToLogFileOnOff( lOnOff )
LOCAL lOld := s_lToLogFile
IF hb_isLogical( lOnOff )
s_lToLogFile := lOnOff
ENDIF
RETURN lOld
FUNCTION HB_EmptyLogFileOnOff( lOnOff )
LOCAL lOld := s_lEmptyLogFile
IF hb_isLogical( lOnOff )
s_lEmptyLogFile := lOnOff
ENDIF
RETURN lOld
PROCEDURE HB_ToLogFile( cLogFile, ... )
LOCAL nHandle
IF !s_lToLogFile
RETURN
ENDIF
DEFAULT cLogFile TO "logfile.log"
IF cLogFile != NIL
IF !s_lEmptyLogFile .AND. hb_FileExists( cLogFile )
nHandle := FOpen( cLogFile, FO_READWRITE + FO_SHARED )
ELSE
nHandle := FCreate( cLogFile )
s_lEmptyLogFile := .F.
// After I have create it I have to close and open in shared way
IF FError() == 0 .AND. nHandle != F_ERROR
FClose( nHandle )
nHandle := FOpen( cLogFile, FO_READWRITE + FO_SHARED )
ENDIF
ENDIF
// Writing
IF nHandle != F_ERROR
FSeek( nHandle, 0, FS_END )
FWrite( nHandle, hb_sprintf( ... ) )
FWrite( nHandle, HB_OSNewLine() )
FClose( nHandle )
ENDIF
ENDIF
RETURN
/*
* $Id: dbgfx.prg 9738 2008-10-26 07:10:19Z vszakats $
*/
/*
* Harbour Project source code:
* Debug Functions
*
* Copyright 2007-2008 Francesco Saverio Giudice <info / at /fsgiudice.com>
* 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 "common.ch"
#include "fileio.ch"
STATIC s_lToOutDebug := .T.
STATIC s_lToLogFile := .T.
STATIC s_lEmptyLogFile := .T.
FUNCTION HB_ToOutDebugOnOff( lOnOff )
LOCAL lOld := s_lToOutDebug
IF hb_isLogical( lOnOff )
s_lToOutDebug := lOnOff
ENDIF
RETURN lOld
PROCEDURE HB_ToOutDebug( ... )
IF s_lToOutDebug
hb_OutDebug( hb_sprintf( ... ) )
ENDIF
RETURN
FUNCTION HB_ToLogFileOnOff( lOnOff )
LOCAL lOld := s_lToLogFile
IF hb_isLogical( lOnOff )
s_lToLogFile := lOnOff
ENDIF
RETURN lOld
FUNCTION HB_EmptyLogFileOnOff( lOnOff )
LOCAL lOld := s_lEmptyLogFile
IF hb_isLogical( lOnOff )
s_lEmptyLogFile := lOnOff
ENDIF
RETURN lOld
PROCEDURE HB_ToLogFile( cLogFile, ... )
LOCAL nHandle
IF !s_lToLogFile
RETURN
ENDIF
DEFAULT cLogFile TO "logfile.log"
IF cLogFile != NIL
IF !s_lEmptyLogFile .AND. hb_FileExists( cLogFile )
nHandle := FOpen( cLogFile, FO_READWRITE + FO_SHARED )
ELSE
nHandle := FCreate( cLogFile )
s_lEmptyLogFile := .F.
// After I have create it I have to close and open in shared way
IF FError() == 0 .AND. nHandle != F_ERROR
FClose( nHandle )
nHandle := FOpen( cLogFile, FO_READWRITE + FO_SHARED )
ENDIF
ENDIF
// Writing
IF nHandle != F_ERROR
FSeek( nHandle, 0, FS_END )
FWrite( nHandle, hb_sprintf( ... ) )
FWrite( nHandle, HB_OSNewLine() )
FClose( nHandle )
ENDIF
ENDIF
RETURN

266
harbour/contrib/xhb/dbgfxc.c
View File

@@ -1,133 +1,133 @@
/*
* $Id: dbgfxc.c 9838 2008-11-05 02:01:15Z druzus $
*/
/*
* Harbour Project source code:
* Debug Functions
*
* Copyright 2007-2008 Francesco Saverio Giudice <info / at /fsgiudice.com>
* 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 "hbapifs.h"
#include "xhb.h"
static BOOL s_bToOutputDebug = TRUE;
static BOOL s_bToLogFile = TRUE;
static BOOL s_bEmptyLogFile = TRUE;
BOOL hb_ToOutDebugOnOff( BOOL bOnOff )
{
BOOL bOld = s_bToOutputDebug;
s_bToOutputDebug = bOnOff;
return bOld;
}
void hb_ToOutDebug( const char * sTraceMsg, ... )
{
if( sTraceMsg && s_bToOutputDebug )
{
char buffer[ 1024 ];
va_list ap;
va_start( ap, sTraceMsg );
vsnprintf( buffer, sizeof( buffer ), sTraceMsg, ap );
va_end( ap );
hb_OutDebug( ( const char * ) buffer, strlen( buffer ) );
}
}
BOOL hb_ToLogFileOnOff( BOOL bOnOff )
{
BOOL bOld = s_bToLogFile;
s_bToLogFile = bOnOff;
return bOld;
}
BOOL hb_EmptyLogFile( BOOL bOnOff )
{
BOOL bOld = s_bEmptyLogFile;
s_bEmptyLogFile = bOnOff;
return bOld;
}
void hb_ToLogFile( const char * sFile, const char * sTraceMsg, ... )
{
if( s_bToLogFile )
{
FILE * hFile;
if( sFile == NULL )
{
if( s_bEmptyLogFile )
{
s_bEmptyLogFile = FALSE;
/* Empty the file if it exists. */
hFile = hb_fopen( "logfile.log", "w" );
}
else
hFile = hb_fopen( "logfile.log", "a" );
}
else
hFile = hb_fopen( sFile, "a" );
if( hFile )
{
va_list ap;
va_start( ap, sTraceMsg );
vfprintf( hFile, sTraceMsg, ap );
va_end( ap );
fclose( hFile );
}
}
}
/*
* $Id: dbgfxc.c 9838 2008-11-05 02:01:15Z druzus $
*/
/*
* Harbour Project source code:
* Debug Functions
*
* Copyright 2007-2008 Francesco Saverio Giudice <info / at /fsgiudice.com>
* 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 "hbapifs.h"
#include "xhb.h"
static BOOL s_bToOutputDebug = TRUE;
static BOOL s_bToLogFile = TRUE;
static BOOL s_bEmptyLogFile = TRUE;
BOOL hb_ToOutDebugOnOff( BOOL bOnOff )
{
BOOL bOld = s_bToOutputDebug;
s_bToOutputDebug = bOnOff;
return bOld;
}
void hb_ToOutDebug( const char * sTraceMsg, ... )
{
if( sTraceMsg && s_bToOutputDebug )
{
char buffer[ 1024 ];
va_list ap;
va_start( ap, sTraceMsg );
vsnprintf( buffer, sizeof( buffer ), sTraceMsg, ap );
va_end( ap );
hb_OutDebug( ( const char * ) buffer, strlen( buffer ) );
}
}
BOOL hb_ToLogFileOnOff( BOOL bOnOff )
{
BOOL bOld = s_bToLogFile;
s_bToLogFile = bOnOff;
return bOld;
}
BOOL hb_EmptyLogFile( BOOL bOnOff )
{
BOOL bOld = s_bEmptyLogFile;
s_bEmptyLogFile = bOnOff;
return bOld;
}
void hb_ToLogFile( const char * sFile, const char * sTraceMsg, ... )
{
if( s_bToLogFile )
{
FILE * hFile;
if( sFile == NULL )
{
if( s_bEmptyLogFile )
{
s_bEmptyLogFile = FALSE;
/* Empty the file if it exists. */
hFile = hb_fopen( "logfile.log", "w" );
}
else
hFile = hb_fopen( "logfile.log", "a" );
}
else
hFile = hb_fopen( sFile, "a" );
if( hFile )
{
va_list ap;
va_start( ap, sTraceMsg );
vfprintf( hFile, sTraceMsg, ap );
va_end( ap );
fclose( hFile );
}
}
}

164
harbour/contrib/xhb/hbstruct.ch
View File

@@ -1,82 +1,82 @@
/*
* $Id: hbstruct.ch 9505 2008-09-25 11:16:49Z toninhofwi $
*/
/*
* Harbour Project source code:
* Header file for cross-compatibility between different Harbour flavours
*
* Copyright 1999-2007 {list of individual authors and e-mail addresses}
* 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 _H_STRUCTURE
#define _H_STRUCTURE
#xcommand STRUCTURE <hStruct> ;
=> ;
#ifdef _TSTRUCT_ ;;
#undef _TSTRUCT_ ;;
#endif ;;
#define _TSTRUCT_ <hStruct> ;;
<hStruct> := HB_Hash() ;;
HB_HCaseMatch( <hStruct>, .f. )
#xcommand MEMBER <cName, ...> ;
[ AS <type:STRING,NUMERIC,LOGICAL,DATE,CODEBLOCK,OBJECT> ] ;
[ INIT <uValue> ] ;
=> ;
HB_HashAddMember( {<(cName)>}, <(type)>, <uValue>, _TSTRUCT_ )
#xcommand MEMBER <cName> ;
[ AS <type:ARRAY> ] ;
[ INIT <uValue> ] ;
=> ;
HB_HashAddMember( {<(cName)>}, <(type)>, <uValue>, _TSTRUCT_ )
#xcommand ENDSTRUCTURE => HB_HAutoAdd( _TSTRUCT_, .f. )
#translate DESTROY STRUCTURE <hStruct> => <hStruct> := nil
#endif
/*
* $Id: hbstruct.ch 9505 2008-09-25 11:16:49Z toninhofwi $
*/
/*
* Harbour Project source code:
* Header file for cross-compatibility between different Harbour flavours
*
* Copyright 1999-2007 {list of individual authors and e-mail addresses}
* 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 _H_STRUCTURE
#define _H_STRUCTURE
#xcommand STRUCTURE <hStruct> ;
=> ;
#ifdef _TSTRUCT_ ;;
#undef _TSTRUCT_ ;;
#endif ;;
#define _TSTRUCT_ <hStruct> ;;
<hStruct> := HB_Hash() ;;
HB_HCaseMatch( <hStruct>, .f. )
#xcommand MEMBER <cName, ...> ;
[ AS <type:STRING,NUMERIC,LOGICAL,DATE,CODEBLOCK,OBJECT> ] ;
[ INIT <uValue> ] ;
=> ;
HB_HashAddMember( {<(cName)>}, <(type)>, <uValue>, _TSTRUCT_ )
#xcommand MEMBER <cName> ;
[ AS <type:ARRAY> ] ;
[ INIT <uValue> ] ;
=> ;
HB_HashAddMember( {<(cName)>}, <(type)>, <uValue>, _TSTRUCT_ )
#xcommand ENDSTRUCTURE => HB_HAutoAdd( _TSTRUCT_, .f. )
#translate DESTROY STRUCTURE <hStruct> => <hStruct> := nil
#endif

240
harbour/contrib/xhb/hbstruct.prg
View File

@@ -1,120 +1,120 @@
/*
* $Id: hbstruct.ch 9505 2008-09-25 11:16:49Z toninhofwi $
*/
/*
* Harbour Project source code:
* Header file for cross-compatibility between different Harbour flavours
*
* Copyright 1999-2007 {list of individual authors and e-mail addresses}
* 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.
*
*/
procedure HB_HashAddMember( aName, cType, uInit, oObj )
local cName
if !( cType == nil )
switch Upper( Left( cType, 1 ) )
case "S" // STRING
if uInit == nil
uInit = ""
endif
exit
case "N" // NUMERIC
if uInit == nil
uInit = 0
endif
exit
case "L" // LOGICAL
if uInit == nil
uInit = .f.
endif
exit
case "D" // DATE
if uInit == nil
uInit = CtoD( "" )
endif
exit
case "C" // CODEBLOCK
if uInit == nil
uInit = { || nil }
endif
exit
case "A" // ARRAY
if uInit == nil
uInit = {}
endif
exit
case "O" // OBJECT
exit
end switch
endif
for each cName in aName
oObj[ cName ] = uInit
next
return
/*
* $Id: hbstruct.ch 9505 2008-09-25 11:16:49Z toninhofwi $
*/
/*
* Harbour Project source code:
* Header file for cross-compatibility between different Harbour flavours
*
* Copyright 1999-2007 {list of individual authors and e-mail addresses}
* 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.
*
*/
procedure HB_HashAddMember( aName, cType, uInit, oObj )
local cName
if !( cType == nil )
switch Upper( Left( cType, 1 ) )
case "S" // STRING
if uInit == nil
uInit = ""
endif
exit
case "N" // NUMERIC
if uInit == nil
uInit = 0
endif
exit
case "L" // LOGICAL
if uInit == nil
uInit = .f.
endif
exit
case "D" // DATE
if uInit == nil
uInit = CtoD( "" )
endif
exit
case "C" // CODEBLOCK
if uInit == nil
uInit = { || nil }
endif
exit
case "A" // ARRAY
if uInit == nil
uInit = {}
endif
exit
case "O" // OBJECT
exit
end switch
endif
for each cName in aName
oObj[ cName ] = uInit
next
return

414
harbour/contrib/xhb/sprintf.prg
View File

@@ -1,207 +1,207 @@
/*
* $Id: sprintf.prg 9693 2008-10-20 06:47:13Z vszakats $
*/
/*
* xHarbour Project source code:
* hb_sprintf() function
*
* Copyright 2003 Mauricio Abre <maurifull@datafull.com>
* www - http://www.xharbour.org
* 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 "common.ch"
FUNCTION hb_sprintf( ... )
LOCAL aPar, cReturn, nPar, nPos, cTok
LOCAL nLen := 0, lUnsigned, l0 := .F., lSign := .F., nDec, xVal
LOCAL cString
aPar := HB_aParams()
cReturn := ""
cString := aPar[1]
nPar := 2
DO WHILE !Empty( cString )
nPos := Len( cString ) + 1
cTok := NIL
IF '%' $ cString
nPos := At( '%', cString )
cTok := '%'
ENDIF
IF '\' $ cString .AND. At( '\', cString ) < nPos
nPos := At( '\', cString )
cTok := '\'
ENDIF
cReturn += Left( cString, nPos - 1 )
DO CASE
CASE cTok == NIL
EXIT
CASE cTok == '\'
SWITCH SubStr( cString, ++nPos, 1 )
CASE 't'
cReturn += ' '
EXIT
CASE 'n'
cReturn += Chr( 13 )
EXIT
CASE 'r'
cReturn += Chr( 10 )
EXIT
OTHERWISE
cReturn += SubStr( cString, nPos, 1 )
EXIT
ENDSWITCH
CASE cTok == '%'
lUnsigned := .F.
SWITCH SubStr( cString, ++nPos, 1 )
CASE '%'
cReturn += '%'
EXIT
CASE '+'
cString := Left( cString, nPos - 1 ) + SubStr( cString, nPos + 1 )
nPos := At( '%', cString ) - 1
lSign := .T.
EXIT
CASE '0'
cString := Left( cString, nPos - 1 ) + SubStr( cString, nPos + 1 )
nPos := At( '%', cString ) - 1
l0 := .T.
EXIT
CASE '1'
CASE '2'
CASE '3'
CASE '4'
CASE '5'
CASE '6'
CASE '7'
CASE '8'
CASE '9'
nLen := Val( SubStr( cString, nPos ) )
cTok := Left( cString, nPos - 1 )
DO WHILE SubStr( cString, nPos, 1 ) $ '1234567890.'
nPos++
ENDDO
cString := cTok + SubStr( cString, nPos )
nPos := At( '%', cString ) - 1
EXIT
CASE 'u'
lUnsigned := .T.
nPos++
CASE 'd'
CASE 'l'
CASE 'f'
CASE 'i'
xVal := aPar[nPar++]
IF !ISNUMBER( xVal )
xVal := 0
ENDIF
IF nLen != 0
IF nLen - Int( nLen ) > 0.0
nDec := Str( nLen )
DO WHILE Right( nDec, 1 ) == '0'
nDec := Left( nDec, Len( nDec ) - 1 )
END
nDec := Val( SubStr( nDec, At( '.', nDec ) + 1 ) )
ELSE
nDec := 0
ENDIF
cTok := Str( IIF( lUnsigned, Abs( xVal ), xVal ), nLen, nDec )
ELSE
cTok := hb_NToS( IIF( lUnsigned, Abs( xVal ), xVal ) )
ENDIF
IF l0
IF '-' $ cTok .AND. Left( cTok, 1 ) != '-'
cTok := StrTran( cTok, '-', ' ' )
cTok := '-' + SubStr( cTok, 2 )
ENDIF
cTok := StrTran( cTok, ' ', '0' )
l0 := .F.
ENDIF
IF lSign .AND. Left( cTok, 1 ) != '-'
IF nLen == 0
cTok := '+' + cTok
ELSE
cTok := '+' + SubStr( cTok, 2 )
ENDIF
lSign := .F.
ENDIF
nLen := 0
cReturn += cTok
EXIT
CASE 'c'
CASE 's'
IF nLen == 0
nLen := Len( hb_cStr( aPar[nPar] ) )
ENDIF
cReturn += PadL( hb_cStr( aPar[nPar++] ), nLen )
nLen := 0
l0 := .F.
lSign := .F.
EXIT
ENDSWITCH
ENDCASE
cString := SubStr( cString, nPos + 1 )
ENDDO
RETURN cReturn
/*
* $Id: sprintf.prg 9693 2008-10-20 06:47:13Z vszakats $
*/
/*
* xHarbour Project source code:
* hb_sprintf() function
*
* Copyright 2003 Mauricio Abre <maurifull@datafull.com>
* www - http://www.xharbour.org
* 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 "common.ch"
FUNCTION hb_sprintf( ... )
LOCAL aPar, cReturn, nPar, nPos, cTok
LOCAL nLen := 0, lUnsigned, l0 := .F., lSign := .F., nDec, xVal
LOCAL cString
aPar := HB_aParams()
cReturn := ""
cString := aPar[1]
nPar := 2
DO WHILE !Empty( cString )
nPos := Len( cString ) + 1
cTok := NIL
IF '%' $ cString
nPos := At( '%', cString )
cTok := '%'
ENDIF
IF '\' $ cString .AND. At( '\', cString ) < nPos
nPos := At( '\', cString )
cTok := '\'
ENDIF
cReturn += Left( cString, nPos - 1 )
DO CASE
CASE cTok == NIL
EXIT
CASE cTok == '\'
SWITCH SubStr( cString, ++nPos, 1 )
CASE 't'
cReturn += ' '
EXIT
CASE 'n'
cReturn += Chr( 13 )
EXIT
CASE 'r'
cReturn += Chr( 10 )
EXIT
OTHERWISE
cReturn += SubStr( cString, nPos, 1 )
EXIT
ENDSWITCH
CASE cTok == '%'
lUnsigned := .F.
SWITCH SubStr( cString, ++nPos, 1 )
CASE '%'
cReturn += '%'
EXIT
CASE '+'
cString := Left( cString, nPos - 1 ) + SubStr( cString, nPos + 1 )
nPos := At( '%', cString ) - 1
lSign := .T.
EXIT
CASE '0'
cString := Left( cString, nPos - 1 ) + SubStr( cString, nPos + 1 )
nPos := At( '%', cString ) - 1
l0 := .T.
EXIT
CASE '1'
CASE '2'
CASE '3'
CASE '4'
CASE '5'
CASE '6'
CASE '7'
CASE '8'
CASE '9'
nLen := Val( SubStr( cString, nPos ) )
cTok := Left( cString, nPos - 1 )
DO WHILE SubStr( cString, nPos, 1 ) $ '1234567890.'
nPos++
ENDDO
cString := cTok + SubStr( cString, nPos )
nPos := At( '%', cString ) - 1
EXIT
CASE 'u'
lUnsigned := .T.
nPos++
CASE 'd'
CASE 'l'
CASE 'f'
CASE 'i'
xVal := aPar[nPar++]
IF !ISNUMBER( xVal )
xVal := 0
ENDIF
IF nLen != 0
IF nLen - Int( nLen ) > 0.0
nDec := Str( nLen )
DO WHILE Right( nDec, 1 ) == '0'
nDec := Left( nDec, Len( nDec ) - 1 )
END
nDec := Val( SubStr( nDec, At( '.', nDec ) + 1 ) )
ELSE
nDec := 0
ENDIF
cTok := Str( IIF( lUnsigned, Abs( xVal ), xVal ), nLen, nDec )
ELSE
cTok := hb_NToS( IIF( lUnsigned, Abs( xVal ), xVal ) )
ENDIF
IF l0
IF '-' $ cTok .AND. Left( cTok, 1 ) != '-'
cTok := StrTran( cTok, '-', ' ' )
cTok := '-' + SubStr( cTok, 2 )
ENDIF
cTok := StrTran( cTok, ' ', '0' )
l0 := .F.
ENDIF
IF lSign .AND. Left( cTok, 1 ) != '-'
IF nLen == 0
cTok := '+' + cTok
ELSE
cTok := '+' + SubStr( cTok, 2 )
ENDIF
lSign := .F.
ENDIF
nLen := 0
cReturn += cTok
EXIT
CASE 'c'
CASE 's'
IF nLen == 0
nLen := Len( hb_cStr( aPar[nPar] ) )
ENDIF
cReturn += PadL( hb_cStr( aPar[nPar++] ), nLen )
nLen := 0
l0 := .F.
lSign := .F.
EXIT
ENDSWITCH
ENDCASE
cString := SubStr( cString, nPos + 1 )
ENDDO
RETURN cReturn

146
harbour/contrib/xhb/xhb.h
View File

@@ -1,73 +1,73 @@
/*
* $Id: hbcompat.h 9702 2008-10-21 20:19:00Z druzus $
*/
/*
* Harbour Project source code:
* Header file for C functions in xhb contrib folder
*
* Copyright 2008 {list of individual authors and e-mail addresses}
* 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_XHB_H_
#define HB_XHB_H_
#include "hbsetup.h"
HB_EXTERN_BEGIN
/* functions in hboutdbg.c */
extern HB_EXPORT BOOL hb_OutDebugName( PHB_ITEM pName );
extern HB_EXPORT void hb_OutDebug( const char * szMsg, ULONG ulMsgLen );
/* functions in dbgfxc.c */
extern HB_EXPORT BOOL hb_ToOutDebugOnOff( BOOL bOnOff );
extern HB_EXPORT void hb_ToOutDebug( const char * sTraceMsg, ... );
extern HB_EXPORT BOOL hb_ToLogFileOnOff( BOOL bOnOff );
extern HB_EXPORT BOOL hb_EmptyLogFile( BOOL bOnOff );
extern HB_EXPORT void hb_ToLogFile( const char * sFile, const char * sTraceMsg, ... );
HB_EXTERN_END
#endif
/*
* $Id: hbcompat.h 9702 2008-10-21 20:19:00Z druzus $
*/
/*
* Harbour Project source code:
* Header file for C functions in xhb contrib folder
*
* Copyright 2008 {list of individual authors and e-mail addresses}
* 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_XHB_H_
#define HB_XHB_H_
#include "hbsetup.h"
HB_EXTERN_BEGIN
/* functions in hboutdbg.c */
extern HB_EXPORT BOOL hb_OutDebugName( PHB_ITEM pName );
extern HB_EXPORT void hb_OutDebug( const char * szMsg, ULONG ulMsgLen );
/* functions in dbgfxc.c */
extern HB_EXPORT BOOL hb_ToOutDebugOnOff( BOOL bOnOff );
extern HB_EXPORT void hb_ToOutDebug( const char * sTraceMsg, ... );
extern HB_EXPORT BOOL hb_ToLogFileOnOff( BOOL bOnOff );
extern HB_EXPORT BOOL hb_EmptyLogFile( BOOL bOnOff );
extern HB_EXPORT void hb_ToLogFile( const char * sFile, const char * sTraceMsg, ... );
HB_EXTERN_END
#endif

2174
harbour/source/common/hbprintf.c
View File

File diff suppressed because it is too large Load Diff

184
harbour/source/rdd/usrrdd/example/exlog.prg
View File

@@ -1,92 +1,92 @@
/*
* $Id: exfcm.prg 9551 2008-10-05 18:13:15Z vszakats $
*/
#include "common.ch"
#include "dbinfo.ch"
#include "hbusrrdd.ch"
// Request for LOGRDD rdd driver
REQUEST LOGRDD
// Here put Request for RDD you want to inherit then add
// function hb_LogRddInherit() (see at bottom)
REQUEST DBFCDX
PROCEDURE Main()
// Set LOGRDD as default RDD otherwise I have to set explicitly use
// with DRIVER option
RDDSetDefault( "LOGRDD" )
// Adding Memofile Info
rddInfo( RDDI_MEMOVERSION, DB_MEMOVER_CLIP, "LOGRDD" )
// Define Log File Name and position
hb_LogRddLogFileName( "logs\changes.log" )
// Define Tag to add for each line logged
hb_LogRddTag( NETNAME() + "\" + hb_USERNAME() )
// Activate Logging, it can be stopped/started at any moment
hb_LogRddActive( .T. )
// Uncomment next command to change logged string that I have to return to standard LOGRDD file
// hb_LogRddMsgLogBlock( {|cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3| MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) } )
// Uncomment next command to change standard destination of my logged string
// hb_LogRddUserLogBlock( {|cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3| hb_toOutDebug( MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) + "\n\r" ) } )
// Start program logic
// Open a table with logging (default RDD is LOGRDD)
USE test
field->name := "Francesco"
CLOSE
// Open a table without logging
USE test VIA "DBFCDX"
APPEND BLANK
field->name := "Francesco"
RETURN
STATIC FUNCTION MyToString( cCmd, nWA, xPar1, xPar2, xPar3 )
LOCAL cString
DO CASE
CASE cCmd == "CREATE"
// Parameters received: xPar1 = aOpenInfo
cString := xPar1[ UR_OI_NAME ]
CASE cCmd == "CREATEFIELDS"
// Parameters received: xPar1 = aStruct
cString := hb_ValToExp( xPar1 )
CASE cCmd == "OPEN"
// Parameters received: xPar1 = aOpenInfo
// cString := 'Table : "' + xPar1[ UR_OI_NAME ] + '", Alias : "' + Alias() + '", WorkArea : ' + LTrim( Str( nWA ) )
// In this example I don't want to log Open Command
CASE cCmd == "CLOSE"
// Parameters received: xPar1 = cTableName, xPar2 = cAlias
//cString := 'Table : "' + xPar1 + '", Alias : "' + xPar2 + '", WorkArea : ' + LTrim( Str( nWA ) )
// In this example I don't want to log Close Command
CASE cCmd == "APPEND"
// Parameters received: xPar1 = lUnlockAll
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "DELETE"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "RECALL"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "PUTVALUE"
// Parameters received: xPar1 = nField, xPar2 = xValue, xPar3 = xOldValue
#ifndef __XHARBOUR__
HB_SYMBOL_UNUSED( xPar3 ) // Here don't log previous value
#endif
cString := Alias() + "(" + LTrim( Str( RecNo() ) ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 )
CASE cCmd == "ZAP"
// Parameters received: none
cString := 'Alias : "' + Alias() + ' Table : "' + dbInfo( DBI_FULLPATH ) + '"'
ENDCASE
RETURN cString
FUNCTION hb_LogRddInherit()
RETURN "DBFCDX"
/*
* $Id: exfcm.prg 9551 2008-10-05 18:13:15Z vszakats $
*/
#include "common.ch"
#include "dbinfo.ch"
#include "hbusrrdd.ch"
// Request for LOGRDD rdd driver
REQUEST LOGRDD
// Here put Request for RDD you want to inherit then add
// function hb_LogRddInherit() (see at bottom)
REQUEST DBFCDX
PROCEDURE Main()
// Set LOGRDD as default RDD otherwise I have to set explicitly use
// with DRIVER option
RDDSetDefault( "LOGRDD" )
// Adding Memofile Info
rddInfo( RDDI_MEMOVERSION, DB_MEMOVER_CLIP, "LOGRDD" )
// Define Log File Name and position
hb_LogRddLogFileName( "logs\changes.log" )
// Define Tag to add for each line logged
hb_LogRddTag( NETNAME() + "\" + hb_USERNAME() )
// Activate Logging, it can be stopped/started at any moment
hb_LogRddActive( .T. )
// Uncomment next command to change logged string that I have to return to standard LOGRDD file
// hb_LogRddMsgLogBlock( {|cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3| MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) } )
// Uncomment next command to change standard destination of my logged string
// hb_LogRddUserLogBlock( {|cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3| hb_toOutDebug( MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) + "\n\r" ) } )
// Start program logic
// Open a table with logging (default RDD is LOGRDD)
USE test
field->name := "Francesco"
CLOSE
// Open a table without logging
USE test VIA "DBFCDX"
APPEND BLANK
field->name := "Francesco"
RETURN
STATIC FUNCTION MyToString( cCmd, nWA, xPar1, xPar2, xPar3 )
LOCAL cString
DO CASE
CASE cCmd == "CREATE"
// Parameters received: xPar1 = aOpenInfo
cString := xPar1[ UR_OI_NAME ]
CASE cCmd == "CREATEFIELDS"
// Parameters received: xPar1 = aStruct
cString := hb_ValToExp( xPar1 )
CASE cCmd == "OPEN"
// Parameters received: xPar1 = aOpenInfo
// cString := 'Table : "' + xPar1[ UR_OI_NAME ] + '", Alias : "' + Alias() + '", WorkArea : ' + LTrim( Str( nWA ) )
// In this example I don't want to log Open Command
CASE cCmd == "CLOSE"
// Parameters received: xPar1 = cTableName, xPar2 = cAlias
//cString := 'Table : "' + xPar1 + '", Alias : "' + xPar2 + '", WorkArea : ' + LTrim( Str( nWA ) )
// In this example I don't want to log Close Command
CASE cCmd == "APPEND"
// Parameters received: xPar1 = lUnlockAll
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "DELETE"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "RECALL"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "PUTVALUE"
// Parameters received: xPar1 = nField, xPar2 = xValue, xPar3 = xOldValue
#ifndef __XHARBOUR__
HB_SYMBOL_UNUSED( xPar3 ) // Here don't log previous value
#endif
cString := Alias() + "(" + LTrim( Str( RecNo() ) ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 )
CASE cCmd == "ZAP"
// Parameters received: none
cString := 'Alias : "' + Alias() + ' Table : "' + dbInfo( DBI_FULLPATH ) + '"'
ENDCASE
RETURN cString
FUNCTION hb_LogRddInherit()
RETURN "DBFCDX"

978
harbour/source/rdd/usrrdd/rdds/logrdd.prg
View File

@@ -1,489 +1,489 @@
/*
* $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $
*/
/*
* Harbour Project source code:
* LOGRDD
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* 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.
*
*/
/*
* A simple RDD which introduce logging to file. It inheriths from
* any existent RDD but if you write / replace / delete something
* on tables it writes changes in a log file.
* An example is avalaible at
* harbour/source/rdd/usrrdd/example/exlog.prg
*/
#include "rddsys.ch"
#ifdef __XHARBOUR__
#include "usrrdd.ch"
#xtranslate hb_valtoexp( => cStr(
#else
#include "hbusrrdd.ch"
#endif
#include "common.ch"
#include "fileio.ch"
#include "dbinfo.ch"
#define ARRAY_FILENAME 1
#define ARRAY_FHANDLE 2
#define ARRAY_TAG 3
#define ARRAY_ACTIVE 4
#define ARRAY_RDDNAME 5
#define ARRAY_MSGLOGBLOCK 6
#define ARRAY_USERLOGBLOCK 7
ANNOUNCE LOGRDD
DYNAMIC HB_LOGRDDINHERIT /* To be defined at user level */
STATIC FUNCTION LOGRDD_INIT( nRDD )
LOCAL lActive, cFileName, cTag, cRDDName
/* Defaults */
cFileName := "changes.log"
lActive := .F.
#ifdef __XHARBOUR__
cTag := NETNAME() + "\" + NETNAME( 1 )
#else
cTag := NETNAME() + "\" + hb_USERNAME()
#endif
cRDDName := hb_LogRddInherit()
/* Log File will be open later so user can change parameters */
/* Store data in RDD cargo */
/* cFileName, nHandle, cTag, lActive, cRDDName, bMsgLogBlock, bUserLogBlock */
USRRDD_RDDDATA( nRDD, { cFileName, NIL, cTag, lActive, cRDDName, NIL, NIL } )
RETURN SUCCESS
STATIC FUNCTION LOGRDD_EXIT( nRDD )
LOCAL aRDDData := USRRDD_RDDDATA( nRDD )
/* Closing log file */
IF aRDDData[ ARRAY_FHANDLE ] != NIL
FClose( aRDDData[ ARRAY_FHANDLE ] )
aRDDData[ ARRAY_FHANDLE ] := NIL
ENDIF
RETURN SUCCESS
// Create database from current WA fields definition
STATIC FUNCTION LOGRDD_CREATE( nWA, aOpenInfo )
LOCAL nResult := UR_SUPER_CREATE( nWA, aOpenInfo )
IF nResult == SUCCESS
ToLog( "CREATE", nWA, aOpenInfo )
ENDIF
RETURN nResult
// Creating fields for new DBF - dbCreate() in current workarea
STATIC FUNCTION LOGRDD_CREATEFIELDS( nWA, aStruct )
LOCAL nResult := UR_SUPER_CREATEFIELDS( nWA, aStruct )
IF nResult == SUCCESS
ToLog( "CREATEFIELDS", nWA, aStruct )
ENDIF
RETURN nResult
// Open workarea
STATIC FUNCTION LOGRDD_OPEN( nWA, aOpenInfo )
LOCAL nResult := UR_SUPER_OPEN( nWA, aOpenInfo )
IF nResult == SUCCESS
ToLog( "OPEN", nWA, aOpenInfo )
ENDIF
RETURN nResult
// Close workarea
STATIC FUNCTION LOGRDD_CLOSE( nWA )
LOCAL cFile := dbInfo( DBI_FULLPATH )
LOCAL cAlias := Alias()
LOCAL nResult := UR_SUPER_CLOSE( nWA )
IF nResult == SUCCESS
ToLog( "CLOSE", nWA, cFile, cAlias )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_APPEND( nWA, lUnlockAll )
LOCAL nResult := UR_SUPER_APPEND( nWA, lUnlockAll )
IF nResult == SUCCESS
ToLog( "APPEND", nWA, lUnlockAll )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_DELETE( nWA )
LOCAL nResult := UR_SUPER_DELETE( nWA )
IF nResult == SUCCESS
ToLog( "DELETE", nWA )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_RECALL( nWA )
LOCAL nResult := UR_SUPER_RECALL( nWA )
IF nResult == SUCCESS
ToLog( "RECALL", nWA )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_PUTVALUE( nWA, nField, xValue )
LOCAL xOldValue := FieldGet( nField )
LOCAL nResult := UR_SUPER_PUTVALUE( nWA, nField, xValue )
//Log Only Changes
IF !( xOldValue == xValue )
ToLog( "PUTVALUE", nWA, nField, xValue, xOldValue )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_ZAP( nWA )
LOCAL nResult := UR_SUPER_ZAP( nWA )
IF nResult == SUCCESS
ToLog( "ZAP", nWA )
ENDIF
RETURN nResult
/* Force linking DBFCDX from which our RDD inherits */
REQUEST DBFCDX
/*
* This function have to exist in all RDD and then name have to be in
* format: <RDDNAME>_GETFUNCTABLE
*/
FUNCTION LOGRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
LOCAL cSuperRDD := hb_LogRddInherit() /* We are inheriting from a User Defined RDD */
LOCAL aMyFunc[ UR_METHODCOUNT ]
aMyFunc[ UR_INIT ] := ( @LOGRDD_INIT() )
aMyFunc[ UR_EXIT ] := ( @LOGRDD_EXIT() )
aMyFunc[ UR_CREATE ] := ( @LOGRDD_CREATE() )
aMyFunc[ UR_CREATEFIELDS ] := ( @LOGRDD_CREATEFIELDS() )
aMyFunc[ UR_OPEN ] := ( @LOGRDD_OPEN() )
aMyFunc[ UR_CLOSE ] := ( @LOGRDD_CLOSE() )
aMyFunc[ UR_APPEND ] := ( @LOGRDD_APPEND() )
aMyFunc[ UR_DELETE ] := ( @LOGRDD_DELETE() )
aMyFunc[ UR_RECALL ] := ( @LOGRDD_RECALL() )
aMyFunc[ UR_PUTVALUE ] := ( @LOGRDD_PUTVALUE() )
aMyFunc[ UR_ZAP ] := ( @LOGRDD_ZAP() )
RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
cSuperRDD, aMyFunc )
INIT PROCEDURE _LOGRDD_INIT()
rddRegister( "LOGRDD", RDT_FULL )
RETURN
/* -------------------------------------------------- */
/* USER UTILITY FUNCTIONS */
/* -------------------------------------------------- */
FUNCTION hb_LogRddLogFileName( cFileName )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL cOldFileName
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
cOldFileName := aRDDData[ ARRAY_FILENAME ]
IF HB_ISSTRING( cFileName )
aRDDData[ ARRAY_FILENAME ] := cFileName
ENDIF
ENDIF
RETURN cOldFileName
FUNCTION hb_LogRddTag( cTag )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL cOldTag
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
cOldTag := aRDDData[ ARRAY_TAG ]
IF HB_ISSTRING( cTag )
aRDDData[ ARRAY_TAG ] := cTag
ENDIF
ENDIF
RETURN cOldTag
FUNCTION hb_LogRddActive( lActive )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL lOldActive
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
lOldActive := aRDDData[ ARRAY_ACTIVE ]
IF HB_ISLOGICAL( lActive )
aRDDData[ ARRAY_ACTIVE ] := lActive
ENDIF
ENDIF
RETURN lOldActive
FUNCTION hb_LogRddMsgLogBlock( bMsgLogBlock )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL bOldMsgLogBlock
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
bOldMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
IF HB_ISBLOCK( bMsgLogBlock )
aRDDData[ ARRAY_MSGLOGBLOCK ] := bMsgLogBlock
ENDIF
ENDIF
RETURN bOldMsgLogBlock
FUNCTION hb_LogRddUserLogBlock( bUserLogBlock )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL bOldUserLogBlock
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
bOldUserLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
IF HB_ISBLOCK( bUserLogBlock )
aRDDData[ ARRAY_USERLOGBLOCK ] := bUserLogBlock
ENDIF
ENDIF
RETURN bOldUserLogBlock
#ifdef __XHARBOUR__
FUNCTION hb_LogRddValueToText( uValue )
LOCAL cType := ValType( uValue )
LOCAL cText := ValToPrg( uValue )
RETURN "[" + cType + "]>>>" + cText + "<<<"
#else
FUNCTION hb_LogRddValueToText( uValue )
LOCAL cType := ValType( uValue )
LOCAL cText
DO CASE
CASE cType == "C"
cText := hb_StrToExp( uValue )
CASE cType == "N"
cText := hb_NToS( uValue )
CASE cType == "D"
cText := DToS( uValue )
cText := "0d" + iif( Empty( cText ), "00000000", cText )
OTHERWISE
cText := hb_ValToStr( uValue )
ENDCASE
RETURN "[" + cType + "]>>>" + cText + "<<<"
#endif
/* -------------------------------------------------- */
/* LOCAL UTILITY FUNCTIONS */
/* -------------------------------------------------- */
STATIC PROCEDURE OpenLogFile( nWA )
LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
LOCAL cFileName := aRDDData[ ARRAY_FILENAME ]
LOCAL nHandle := aRDDData[ ARRAY_FHANDLE ]
LOCAL lActive := aRDDData[ ARRAY_ACTIVE ]
//TraceLog( "nHandle " + cStr( nHandle ) )
IF lActive .AND. nHandle == NIL
/* Open Access Log File */
IF File( cFileName )
nHandle := FOpen( cFileName, FO_READWRITE + FO_SHARED )
ELSE
nHandle := FCreate( cFileName )
/* Close and reopen in shared mode */
IF FError() == 0 .AND. nHandle > 0
FClose( nHandle )
nHandle := FOpen( cFileName, FO_READWRITE + FO_SHARED )
ENDIF
ENDIF
IF FError() == 0 .AND. nHandle > 0
/* Move to end of file */
FSeek( nHandle, 0, FS_END )
ELSE
nHandle := NIL
ENDIF
aRDDData[ ARRAY_FHANDLE ] := nHandle
ENDIF
RETURN
STATIC FUNCTION ToString( cCmd, nWA, xPar1, xPar2, xPar3 )
LOCAL cString
DO CASE
CASE cCmd == "CREATE"
// Parameters received: xPar1 = aOpenInfo
cString := xPar1[ UR_OI_NAME ]
CASE cCmd == "CREATEFIELDS"
// Parameters received: xPar1 = aStruct
cString := hb_ValToExp( xPar1 )
CASE cCmd == "OPEN"
// Parameters received: xPar1 = aOpenInfo
cString := 'Table : "' + xPar1[ UR_OI_NAME ] + '", Alias : "' + Alias() + '", WorkArea : ' + LTrim( Str( nWA ) )
CASE cCmd == "CLOSE"
// Parameters received: xPar1 = cTableName, xPar2 = cAlias
cString := 'Table : "' + xPar1 + '", Alias : "' + xPar2 + '", WorkArea : ' + LTrim( Str( nWA ) )
CASE cCmd == "APPEND"
// Parameters received: xPar1 = lUnlockAll
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "DELETE"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "RECALL"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "PUTVALUE"
// Parameters received: xPar1 = nField, xPar2 = xValue, xPar3 = xOldValue
#ifndef __XHARBOUR__
HB_SYMBOL_UNUSED( xPar3 ) // Here don't log previous value
#endif
cString := Alias() + "(" + LTrim( Str( RecNo() ) ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 )
CASE cCmd == "ZAP"
// Parameters received: none
cString := 'Alias : "' + Alias() + ' Table : "' + dbInfo( DBI_FULLPATH ) + '"'
ENDCASE
RETURN cString
STATIC PROCEDURE ToLog( cCmd, nWA, xPar1, xPar2, xPar3 )
LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
LOCAL lActive := aRDDData[ ARRAY_ACTIVE ]
LOCAL nHandle, cTag, cRDDName, bMsgLogBlock, bUserLogBlock, cLog
// Check if logging system is active
IF lActive
cTag := aRDDData[ ARRAY_TAG ]
cRDDName := aRDDData[ ARRAY_RDDNAME ]
bUserLogBlock := aRDDData[ ARRAY_USERLOGBLOCK ]
// If not defined a User codeblock
IF !HB_ISBLOCK( bUserLogBlock )
nHandle := aRDDData[ ARRAY_FHANDLE ]
// If log file is not already open I open now
IF nHandle == NIL
OpenLogFile( nWA )
ENDIF
IF nHandle != NIL
bMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
// If defined a codeblock I send to user infos and he has to return a formatted string
// Look at local ToString() function for details
IF HB_ISBLOCK( bMsgLogBlock )
cLog := Eval( bMsgLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 )
ELSE
cLog := DToS( Date() ) + " " + Time() + " " + cTag + ": " + PadR( cRDDName + "_" + cCmd, 20 ) + " - " + ToString( cCmd, nWA, xPar1, xPar2, xPar3 )
ENDIF
// Log to file only if cLog is a valid string
IF HB_ISSTRING( cLog )
FWrite( nHandle, cLog + hb_OSNewLine() )
ENDIF
ENDIF
ELSE
// Otherwise I send all to user that is responsible to log everywhere
Eval( bUserLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 )
ENDIF
ENDIF
RETURN
/*
* $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $
*/
/*
* Harbour Project source code:
* LOGRDD
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* 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.
*
*/
/*
* A simple RDD which introduce logging to file. It inheriths from
* any existent RDD but if you write / replace / delete something
* on tables it writes changes in a log file.
* An example is avalaible at
* harbour/source/rdd/usrrdd/example/exlog.prg
*/
#include "rddsys.ch"
#ifdef __XHARBOUR__
#include "usrrdd.ch"
#xtranslate hb_valtoexp( => cStr(
#else
#include "hbusrrdd.ch"
#endif
#include "common.ch"
#include "fileio.ch"
#include "dbinfo.ch"
#define ARRAY_FILENAME 1
#define ARRAY_FHANDLE 2
#define ARRAY_TAG 3
#define ARRAY_ACTIVE 4
#define ARRAY_RDDNAME 5
#define ARRAY_MSGLOGBLOCK 6
#define ARRAY_USERLOGBLOCK 7
ANNOUNCE LOGRDD
DYNAMIC HB_LOGRDDINHERIT /* To be defined at user level */
STATIC FUNCTION LOGRDD_INIT( nRDD )
LOCAL lActive, cFileName, cTag, cRDDName
/* Defaults */
cFileName := "changes.log"
lActive := .F.
#ifdef __XHARBOUR__
cTag := NETNAME() + "\" + NETNAME( 1 )
#else
cTag := NETNAME() + "\" + hb_USERNAME()
#endif
cRDDName := hb_LogRddInherit()
/* Log File will be open later so user can change parameters */
/* Store data in RDD cargo */
/* cFileName, nHandle, cTag, lActive, cRDDName, bMsgLogBlock, bUserLogBlock */
USRRDD_RDDDATA( nRDD, { cFileName, NIL, cTag, lActive, cRDDName, NIL, NIL } )
RETURN SUCCESS
STATIC FUNCTION LOGRDD_EXIT( nRDD )
LOCAL aRDDData := USRRDD_RDDDATA( nRDD )
/* Closing log file */
IF aRDDData[ ARRAY_FHANDLE ] != NIL
FClose( aRDDData[ ARRAY_FHANDLE ] )
aRDDData[ ARRAY_FHANDLE ] := NIL
ENDIF
RETURN SUCCESS
// Create database from current WA fields definition
STATIC FUNCTION LOGRDD_CREATE( nWA, aOpenInfo )
LOCAL nResult := UR_SUPER_CREATE( nWA, aOpenInfo )
IF nResult == SUCCESS
ToLog( "CREATE", nWA, aOpenInfo )
ENDIF
RETURN nResult
// Creating fields for new DBF - dbCreate() in current workarea
STATIC FUNCTION LOGRDD_CREATEFIELDS( nWA, aStruct )
LOCAL nResult := UR_SUPER_CREATEFIELDS( nWA, aStruct )
IF nResult == SUCCESS
ToLog( "CREATEFIELDS", nWA, aStruct )
ENDIF
RETURN nResult
// Open workarea
STATIC FUNCTION LOGRDD_OPEN( nWA, aOpenInfo )
LOCAL nResult := UR_SUPER_OPEN( nWA, aOpenInfo )
IF nResult == SUCCESS
ToLog( "OPEN", nWA, aOpenInfo )
ENDIF
RETURN nResult
// Close workarea
STATIC FUNCTION LOGRDD_CLOSE( nWA )
LOCAL cFile := dbInfo( DBI_FULLPATH )
LOCAL cAlias := Alias()
LOCAL nResult := UR_SUPER_CLOSE( nWA )
IF nResult == SUCCESS
ToLog( "CLOSE", nWA, cFile, cAlias )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_APPEND( nWA, lUnlockAll )
LOCAL nResult := UR_SUPER_APPEND( nWA, lUnlockAll )
IF nResult == SUCCESS
ToLog( "APPEND", nWA, lUnlockAll )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_DELETE( nWA )
LOCAL nResult := UR_SUPER_DELETE( nWA )
IF nResult == SUCCESS
ToLog( "DELETE", nWA )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_RECALL( nWA )
LOCAL nResult := UR_SUPER_RECALL( nWA )
IF nResult == SUCCESS
ToLog( "RECALL", nWA )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_PUTVALUE( nWA, nField, xValue )
LOCAL xOldValue := FieldGet( nField )
LOCAL nResult := UR_SUPER_PUTVALUE( nWA, nField, xValue )
//Log Only Changes
IF !( xOldValue == xValue )
ToLog( "PUTVALUE", nWA, nField, xValue, xOldValue )
ENDIF
RETURN nResult
STATIC FUNCTION LOGRDD_ZAP( nWA )
LOCAL nResult := UR_SUPER_ZAP( nWA )
IF nResult == SUCCESS
ToLog( "ZAP", nWA )
ENDIF
RETURN nResult
/* Force linking DBFCDX from which our RDD inherits */
REQUEST DBFCDX
/*
* This function have to exist in all RDD and then name have to be in
* format: <RDDNAME>_GETFUNCTABLE
*/
FUNCTION LOGRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
LOCAL cSuperRDD := hb_LogRddInherit() /* We are inheriting from a User Defined RDD */
LOCAL aMyFunc[ UR_METHODCOUNT ]
aMyFunc[ UR_INIT ] := ( @LOGRDD_INIT() )
aMyFunc[ UR_EXIT ] := ( @LOGRDD_EXIT() )
aMyFunc[ UR_CREATE ] := ( @LOGRDD_CREATE() )
aMyFunc[ UR_CREATEFIELDS ] := ( @LOGRDD_CREATEFIELDS() )
aMyFunc[ UR_OPEN ] := ( @LOGRDD_OPEN() )
aMyFunc[ UR_CLOSE ] := ( @LOGRDD_CLOSE() )
aMyFunc[ UR_APPEND ] := ( @LOGRDD_APPEND() )
aMyFunc[ UR_DELETE ] := ( @LOGRDD_DELETE() )
aMyFunc[ UR_RECALL ] := ( @LOGRDD_RECALL() )
aMyFunc[ UR_PUTVALUE ] := ( @LOGRDD_PUTVALUE() )
aMyFunc[ UR_ZAP ] := ( @LOGRDD_ZAP() )
RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
cSuperRDD, aMyFunc )
INIT PROCEDURE _LOGRDD_INIT()
rddRegister( "LOGRDD", RDT_FULL )
RETURN
/* -------------------------------------------------- */
/* USER UTILITY FUNCTIONS */
/* -------------------------------------------------- */
FUNCTION hb_LogRddLogFileName( cFileName )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL cOldFileName
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
cOldFileName := aRDDData[ ARRAY_FILENAME ]
IF HB_ISSTRING( cFileName )
aRDDData[ ARRAY_FILENAME ] := cFileName
ENDIF
ENDIF
RETURN cOldFileName
FUNCTION hb_LogRddTag( cTag )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL cOldTag
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
cOldTag := aRDDData[ ARRAY_TAG ]
IF HB_ISSTRING( cTag )
aRDDData[ ARRAY_TAG ] := cTag
ENDIF
ENDIF
RETURN cOldTag
FUNCTION hb_LogRddActive( lActive )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL lOldActive
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
lOldActive := aRDDData[ ARRAY_ACTIVE ]
IF HB_ISLOGICAL( lActive )
aRDDData[ ARRAY_ACTIVE ] := lActive
ENDIF
ENDIF
RETURN lOldActive
FUNCTION hb_LogRddMsgLogBlock( bMsgLogBlock )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL bOldMsgLogBlock
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
bOldMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
IF HB_ISBLOCK( bMsgLogBlock )
aRDDData[ ARRAY_MSGLOGBLOCK ] := bMsgLogBlock
ENDIF
ENDIF
RETURN bOldMsgLogBlock
FUNCTION hb_LogRddUserLogBlock( bUserLogBlock )
LOCAL nRDD, aRDDList
LOCAL aRDDData
LOCAL bOldUserLogBlock
aRDDList := RDDLIST( RDT_FULL )
nRDD := AScan( aRDDList, "LOGRDD" )
IF nRDD > 0
nRDD -- // HACK: Possibly an error of nRDD value in UR_INIT() ? - TODO
aRDDData := USRRDD_RDDDATA( nRDD )
bOldUserLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
IF HB_ISBLOCK( bUserLogBlock )
aRDDData[ ARRAY_USERLOGBLOCK ] := bUserLogBlock
ENDIF
ENDIF
RETURN bOldUserLogBlock
#ifdef __XHARBOUR__
FUNCTION hb_LogRddValueToText( uValue )
LOCAL cType := ValType( uValue )
LOCAL cText := ValToPrg( uValue )
RETURN "[" + cType + "]>>>" + cText + "<<<"
#else
FUNCTION hb_LogRddValueToText( uValue )
LOCAL cType := ValType( uValue )
LOCAL cText
DO CASE
CASE cType == "C"
cText := hb_StrToExp( uValue )
CASE cType == "N"
cText := hb_NToS( uValue )
CASE cType == "D"
cText := DToS( uValue )
cText := "0d" + iif( Empty( cText ), "00000000", cText )
OTHERWISE
cText := hb_ValToStr( uValue )
ENDCASE
RETURN "[" + cType + "]>>>" + cText + "<<<"
#endif
/* -------------------------------------------------- */
/* LOCAL UTILITY FUNCTIONS */
/* -------------------------------------------------- */
STATIC PROCEDURE OpenLogFile( nWA )
LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
LOCAL cFileName := aRDDData[ ARRAY_FILENAME ]
LOCAL nHandle := aRDDData[ ARRAY_FHANDLE ]
LOCAL lActive := aRDDData[ ARRAY_ACTIVE ]
//TraceLog( "nHandle " + cStr( nHandle ) )
IF lActive .AND. nHandle == NIL
/* Open Access Log File */
IF File( cFileName )
nHandle := FOpen( cFileName, FO_READWRITE + FO_SHARED )
ELSE
nHandle := FCreate( cFileName )
/* Close and reopen in shared mode */
IF FError() == 0 .AND. nHandle > 0
FClose( nHandle )
nHandle := FOpen( cFileName, FO_READWRITE + FO_SHARED )
ENDIF
ENDIF
IF FError() == 0 .AND. nHandle > 0
/* Move to end of file */
FSeek( nHandle, 0, FS_END )
ELSE
nHandle := NIL
ENDIF
aRDDData[ ARRAY_FHANDLE ] := nHandle
ENDIF
RETURN
STATIC FUNCTION ToString( cCmd, nWA, xPar1, xPar2, xPar3 )
LOCAL cString
DO CASE
CASE cCmd == "CREATE"
// Parameters received: xPar1 = aOpenInfo
cString := xPar1[ UR_OI_NAME ]
CASE cCmd == "CREATEFIELDS"
// Parameters received: xPar1 = aStruct
cString := hb_ValToExp( xPar1 )
CASE cCmd == "OPEN"
// Parameters received: xPar1 = aOpenInfo
cString := 'Table : "' + xPar1[ UR_OI_NAME ] + '", Alias : "' + Alias() + '", WorkArea : ' + LTrim( Str( nWA ) )
CASE cCmd == "CLOSE"
// Parameters received: xPar1 = cTableName, xPar2 = cAlias
cString := 'Table : "' + xPar1 + '", Alias : "' + xPar2 + '", WorkArea : ' + LTrim( Str( nWA ) )
CASE cCmd == "APPEND"
// Parameters received: xPar1 = lUnlockAll
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "DELETE"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "RECALL"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
CASE cCmd == "PUTVALUE"
// Parameters received: xPar1 = nField, xPar2 = xValue, xPar3 = xOldValue
#ifndef __XHARBOUR__
HB_SYMBOL_UNUSED( xPar3 ) // Here don't log previous value
#endif
cString := Alias() + "(" + LTrim( Str( RecNo() ) ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 )
CASE cCmd == "ZAP"
// Parameters received: none
cString := 'Alias : "' + Alias() + ' Table : "' + dbInfo( DBI_FULLPATH ) + '"'
ENDCASE
RETURN cString
STATIC PROCEDURE ToLog( cCmd, nWA, xPar1, xPar2, xPar3 )
LOCAL aRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
LOCAL lActive := aRDDData[ ARRAY_ACTIVE ]
LOCAL nHandle, cTag, cRDDName, bMsgLogBlock, bUserLogBlock, cLog
// Check if logging system is active
IF lActive
cTag := aRDDData[ ARRAY_TAG ]
cRDDName := aRDDData[ ARRAY_RDDNAME ]
bUserLogBlock := aRDDData[ ARRAY_USERLOGBLOCK ]
// If not defined a User codeblock
IF !HB_ISBLOCK( bUserLogBlock )
nHandle := aRDDData[ ARRAY_FHANDLE ]
// If log file is not already open I open now
IF nHandle == NIL
OpenLogFile( nWA )
ENDIF
IF nHandle != NIL
bMsgLogBlock := aRDDData[ ARRAY_MSGLOGBLOCK ]
// If defined a codeblock I send to user infos and he has to return a formatted string
// Look at local ToString() function for details
IF HB_ISBLOCK( bMsgLogBlock )
cLog := Eval( bMsgLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 )
ELSE
cLog := DToS( Date() ) + " " + Time() + " " + cTag + ": " + PadR( cRDDName + "_" + cCmd, 20 ) + " - " + ToString( cCmd, nWA, xPar1, xPar2, xPar3 )
ENDIF
// Log to file only if cLog is a valid string
IF HB_ISSTRING( cLog )
FWrite( nHandle, cLog + hb_OSNewLine() )
ENDIF
ENDIF
ELSE
// Otherwise I send all to user that is responsible to log everywhere
Eval( bUserLogBlock, cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 )
ENDIF
ENDIF
RETURN