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

2009-03-19 19:49 UTC+0100 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* xhb/Makefile
  * xhb/dumpvar.prg
  + xhb/decode.prg
    + Added HB_DECODE().
    * Syntax adapted for Harbour.
This commit is contained in:
Viktor Szakats
2009-03-19 18:50:21 +00:00
parent 7589f0c672
commit ff4bdc2bce
4 changed files with 492 additions and 207 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
harbour/ChangeLog
View File

@@ -8,6 +8,13 @@
2009-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2009-03-19 19:49 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* xhb/Makefile
* xhb/dumpvar.prg
+ xhb/decode.prg
+ Added HB_DECODE().
* Syntax adapted for Harbour.
2009-03-19 19:05 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* source/vm/maindll.c
* source/vm/maindllp.c

1
harbour/contrib/xhb/Makefile
View File

@@ -40,6 +40,7 @@ PRG_SOURCES=\
arrayblk.prg \
cstruct.prg \
dbgfx.prg \
decode.prg \
dirrec.prg \
dumpvar.prg \
hblog.prg \

276
harbour/contrib/xhb/decode.prg Normal file
View File

@@ -0,0 +1,276 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Decode function
*
* Copyright 2006 Francesco Saverio Giudice <info / at / fsgiudice / dot / com>
* www - http://www.harbour-project.org
* 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 "common.ch"
/*
PROCEDURE Main()
LOCAL aArray
? "DECODE FUNCTION TESTS"
// Single, return empty value
? Decode( 10 )
// A list
? Decode( 3, 1, "A", 2, "B", 3, "C" )
// A list with default
? Decode( 4, 1, "A", 2, "B", 3, "C", "X" )
// Using an array as list of values to check
? Decode( 2, { 1, "A", 2, "B", 3, "C" } )
// Using an array with default as list of values to check
? Decode( 2, { 1, "A", 2, "B", 3, "C", "X" } )
// Using an hash as list
? Decode( 2, { 1 => "A", 2 => "B", 3 => "C" } )
// Returning a codeblock
? cStr( Decode( 2, 1, {|| 1 }, 2, {|| 2 }, 3, {|| 3 } ) )
// Checking an array
aArray := { 1 }
? Decode( aArray, aArray, "A", { 2 }, "B", { 3 }, "C" )
RETURN
*/
/******************
* Function .......: hb_Decode( <var>, [ <case1,ret1 [,...,caseN,retN] ] [, <def> ]> ) ---> <xRet>
* Author .........: Francesco Saverio Giudice
* Date of creation: 25/01/1991
* Last revision ..: 24/01/2006 1.13 - rewritten for xHarbour and renamed in hb_Decode()
*
* Decode a value from a list.
*******************/
FUNCTION HB_Decode(...)
LOCAL aParams, nParams, xDefault
LOCAL xVal, cKey, xRet
LOCAL aValues, aResults, n, i, nPos, nLen
aParams := hb_aParams()
nParams := PCount()
xDefault := NIL
DO CASE
CASE nParams > 1 // More parameters, real case
xVal := aParams[ 1 ]
hb_ADel( aParams, 1, TRUE ) // Resize params
nParams := Len( aParams )
// if I have a odd number of members, last is default
IF ( nParams % 2 <> 0 )
xDefault := aTail( aParams )
// Resize again deleting last
hb_ADel( aParams, nParams, TRUE )
nParams := Len( aParams )
ENDIF
// Ok because I have no other value than default, I will check if it is a complex value
// like an array or an hash, so I can get it to decode values
IF xDefault <> NIL .AND. ;
( ValType( xDefault ) == "A" .OR. ;
ValType( xDefault ) == "H" )
// If it is an array I will restart this function creating a linear call
IF ValType( xDefault ) == "A" .AND. Len( xDefault ) > 0
// I can have a linear array like { 1, "A", 2, "B", 3, "C" }
// or an array of array couples like { { 1, "A" }, { 2, "B" }, { 3, "C" } }
// first element tell me what type is
// couples of values
IF ValType( xDefault[ 1 ] ) == "A"
//// If i have an array as default, this contains couples of key / value
//// so I have to convert in a linear array
nLen := Len( xDefault )
// Check if array has a default value, this will be last value and has a value
// different from an array
IF !( ValType( xDefault[ nLen ] ) == "A" )
aParams := Array( ( nLen - 1 ) * 2 )
n := 1
FOR i := 1 TO nLen - 1
aParams[ n++ ] := xDefault[ i ][ 1 ]
aParams[ n++ ] := xDefault[ i ][ 2 ]
NEXT
aAdd( aParams, xDefault[ nLen ] )
ELSE
// I haven't a default
aParams := Array( Len( xDefault ) * 2 )
n := 1
FOR i := 1 TO Len( xDefault )
aParams[ n++ ] := xDefault[ i ][ 1 ]
aParams[ n++ ] := xDefault[ i ][ 2 ]
NEXT
ENDIF
ELSE
// I have a linear array
aParams := xDefault
ENDIF
// If it is an hash, translate it in an array
ELSEIF ValType( xDefault ) == "H"
aParams := Array( Len( xDefault ) * 2 )
i := 1
FOR EACH cKey IN xDefault:Keys
aParams[ i++ ] := cKey
aParams[ i++ ] := xDefault[ cKey ]
NEXT
ENDIF
// Then add Decoding value at beginning
hb_AIns( aParams, 1, xVal, TRUE )
// And run decode() again
xRet := hb_ExecFromArray( @hb_Decode(), aParams )
ELSE
// Ok let's go ahead with real function
// Combine in 2 lists having elements as { value } and { decode }
aValues := Array( nParams / 2 )
aResults := Array( nParams / 2 )
i := 1
FOR n := 1 TO nParams - 1 STEP 2
aValues[ i ] := aParams[ n ]
aResults[ i ] := aParams[ n + 1 ]
i++
NEXT
// Check if value exists (valtype of values MUST be same of xVal,
// otherwise I will get a runtime error)
// TODO: Have I to check also between different valtypes, jumping different ?
nPos := aScan( aValues, {|e| e == xVal } )
IF nPos == 0 // Not Found, returning default
xRet := xDefault // it could be also nil because not present
ELSE
xRet := aResults[ nPos ]
ENDIF
ENDIF
CASE nParams == 0 // No parameters
xRet := NIL
CASE nParams == 1 // Only value to decode as parameter, return an empty value of itself
xRet := EmptyValue( aParams[ 1 ] )
ENDCASE
RETURN xRet
FUNCTION HB_DecodeOrEmpty(...)
LOCAL aParams := hb_aParams()
LOCAL xVal := hb_ExecFromArray( @hb_decode(), aParams )
RETURN iif( xVal == NIL, EmptyValue( aParams[ 1 ] ), xVal )
STATIC FUNCTION EmptyValue( xVal )
LOCAL xRet
LOCAL cType := ValType( xVal )
SWITCH cType
CASE "C" // Char
CASE "M" // Memo
xRet := ""
EXIT
CASE "D" // Date
xRet := CTOD("")
EXIT
CASE "L" // Logical
xRet := .F.
EXIT
CASE "N" // Number
xRet := 0
EXIT
CASE "B" // code block
xRet := {|| NIL }
EXIT
CASE "A" // array
xRet := {}
EXIT
CASE "H" // hash
xRet := {=>}
EXIT
CASE "U" // undefined
xRet := NIL
EXIT
CASE "O" // Object
xRet := NIL // Or better another value ?
EXIT
OTHERWISE
// Create a runtime error for new datatypes
xRet := ""
IF xRet == 0 // BANG!
ENDIF
ENDSWITCH
RETURN xRet

415
harbour/contrib/xhb/dumpvar.prg
View File

@@ -50,9 +50,10 @@
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "common.ch"
#define CRLF HB_OsNewLine()
/*
@@ -81,257 +82,257 @@ PROCEDURE __OutDebug( ... )
*/
FUNCTION HB_DumpVar( xVar, lRecursive, nMaxRecursionLevel )
LOCAL nRecursionLevel := 1
LOCAL nIndent := 0
LOCAL nRecursionLevel := 1
LOCAL nIndent := 0
//TraceLog( "HB_DumpVariable: xVar, lAssocAsObj, lRecursive", xVar, lAssocAsObj, lRecursive )
//TraceLog( "HB_DumpVariable: xVar, lAssocAsObj, lRecursive", xVar, lAssocAsObj, lRecursive )
DEFAULT nMaxRecursionLevel TO 0
DEFAULT nMaxRecursionLevel TO 0
RETURN __HB_DumpVar( xVar,, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
RETURN __HB_DumpVar( xVar,, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
STATIC FUNCTION __HB_DumpVar( xVar, lAssocAsObj, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL cType := ValType( xVar )
LOCAL cString := "", cKey
LOCAL cType := ValType( xVar )
LOCAL cString := "", cKey
DEFAULT lAssocAsObj TO FALSE
DEFAULT lRecursive TO FALSE
DEFAULT lAssocAsObj TO FALSE
DEFAULT lRecursive TO FALSE
//TraceLog( "Recursion: xVar, nRecursionLevel, nMaxRecursionLevel", xVar, nRecursionLevel, nMaxRecursionLevel )
//TraceLog( "Recursion: xVar, nRecursionLevel, nMaxRecursionLevel", xVar, nRecursionLevel, nMaxRecursionLevel )
// return if there is limit in recursion
IF nMaxRecursionLevel > 0 .AND. ;
nRecursionLevel > nMaxRecursionLevel
RETURN AsString( xVar )
ENDIF
// return if there is limit in recursion
IF nMaxRecursionLevel > 0 .AND. ;
nRecursionLevel > nMaxRecursionLevel
RETURN AsString( xVar )
ENDIF
DO CASE
CASE cType == "O"
DO CASE
CASE cType == "O"
IF !lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY"
cString += Space( nIndent ) + "Type='Associative' -> " + CRLF
// Keys extraction.
IF Len( xVar:Keys ) > 0
cString += Space( nIndent ) + "{" + CRLF
FOR EACH cKey IN xVar:Keys
cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + CRLF
IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += __HB_DumpVar( xVar:SendKey( cKey ),, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
ENDIF
NEXT
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
ELSE
cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + CRLF
cString += Space( nIndent ) + " | " + CRLF
cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
cString += Space( nIndent ) + " +- PROTECTED:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_PROTECTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
cString += Space( nIndent ) + " +- EXPORTED/VISIBLE/PUBLIC:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_EXPORTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
IF !lAssocAsObj .AND. xVar:ClassName == "TASSOCIATIVEARRAY"
cString += Space( nIndent ) + "Type='Associative' -> " + CRLF
// Keys extraction.
IF Len( xVar:Keys ) > 0
cString += Space( nIndent ) + "{" + CRLF
FOR EACH cKey IN xVar:Keys
cString += Space( nIndent ) + " '" + cKey + "' => " + asString( xVar:SendKey( cKey ) ) + ", " + CRLF
IF lRecursive .AND. ValType( xVar:SendKey( cKey ) ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += __HB_DumpVar( xVar:SendKey( cKey ),, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
ENDIF
NEXT
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
ELSE
cString += Space( nIndent ) + "<" + xVar:ClassName + " Object>" + CRLF
cString += Space( nIndent ) + " | " + CRLF
cString += Space( nIndent ) + " +- PRIVATE/HIDDEN:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_HIDDEN, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
cString += Space( nIndent ) + " +- PROTECTED:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_PROTECTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
cString += Space( nIndent ) + " +- EXPORTED/VISIBLE/PUBLIC:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_EXPORTED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
#ifdef __XHARBOUR__
cString += Space( nIndent ) + " +- PUBLISHED:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_PUBLISHED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
cString += Space( nIndent ) + " +- PUBLISHED:" + CRLF
cString += DShowProperties( xVar, HB_OO_CLSTP_PUBLISHED, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
#endif
cString += Space( nIndent ) + " +----------->" + CRLF
ENDIF
cString += Space( nIndent ) + " +----------->" + CRLF
ENDIF
CASE cType == "A"
IF nRecursionLevel == 1
cString += Space( nIndent ) + "Type='A' -> { Array of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + CRLF
ENDIF
IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel
cString += AsString( xVar )
ELSE
cString += DShowArray( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
ENDIF
CASE cType == "A"
IF nRecursionLevel == 1
cString += Space( nIndent ) + "Type='A' -> { Array of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + CRLF
ENDIF
IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel
cString += AsString( xVar )
ELSE
cString += DShowArray( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
ENDIF
CASE cType == "H"
IF nRecursionLevel == 1
cString += Space( nIndent ) + "Type='H' -> { Hash of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + CRLF
ENDIF
IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel
cString += AsString( xVar )
ELSE
cString += DShowHash( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
ENDIF
CASE cType == "H"
IF nRecursionLevel == 1
cString += Space( nIndent ) + "Type='H' -> { Hash of " + LTrim( Str( Len( xVar ) ) ) + " Items }" + CRLF
ENDIF
IF nMaxRecursionLevel > 0 .AND. nRecursionLevel > nMaxRecursionLevel
cString += AsString( xVar )
ELSE
cString += DShowHash( xVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
ENDIF
OTHERWISE
cString += Space( nIndent ) + AsString( xVar ) + CRLF
ENDCASE
OTHERWISE
cString += Space( nIndent ) + AsString( xVar ) + CRLF
ENDCASE
RETURN cString
RETURN cString
STATIC FUNCTION DShowProperties( oVar, nScope, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL xProp, aProps
LOCAL aMethods, aMth
LOCAL lOldScope
LOCAL cString := ""
LOCAL xProp, aProps
LOCAL aMethods, aMth
LOCAL lOldScope
LOCAL cString := ""
DEFAULT nIndent TO 0
DEFAULT nIndent TO 0
IF ValType( oVar ) == "O"
lOldScope := __SetClassScope( .F. )
aMethods := __objGetMsgFullList( oVar, .F., HB_MSGLISTALL, nScope )
aProps := __objGetValueFullList( oVar, NIL, nScope )
__SetClassScope( lOldScope )
IF ValType( oVar ) == "O"
lOldScope := __SetClassScope( .F. )
aMethods := __objGetMsgFullList( oVar, .F., HB_MSGLISTALL, nScope )
aProps := __objGetValueFullList( oVar, NIL, nScope )
__SetClassScope( lOldScope )
IF Len( aProps ) > 0
cString += Space( nIndent ) + " | +- >> Begin Data ------" + CRLF
FOR EACH xProp IN aProps
cString += Space( nIndent ) + " | +- " + PadR( xProp[ HB_OO_DATA_SYMBOL ], 20 ) + " [" + DecodeType( xProp[ HB_OO_DATA_TYPE ] ) + "] [" + DecodeScope( xProp[ HB_OO_DATA_SCOPE ] ) + "] " + ValType( xProp[ HB_OO_DATA_VALUE ] ) + " => " + AsString( xProp[ HB_OO_DATA_VALUE ] ) + CRLF
IF lRecursive .AND. ValType( xProp[ HB_OO_DATA_VALUE ] ) $ "AO"
cString += __HB_DumpVar( xProp[ HB_OO_DATA_VALUE ],, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel ) + CRLF
ENDIF
NEXT
cString += Space( nIndent ) + " | +- >> End Data ------" + CRLF
cString += Space( nIndent ) + " | " + CRLF
ENDIF
IF Len( aMethods ) > 0
cString += Space( nIndent ) + " | +- >> Begin Methods ------" + CRLF
FOR EACH aMth IN aMethods
cString += Space( nIndent ) + " | +- " + PadR( aMth[HB_OO_DATA_SYMBOL], 20 ) + " [" + DecodeType( aMth[HB_OO_DATA_TYPE] ) + "]" + " [" + DecodeScope( aMth[HB_OO_DATA_SCOPE] ) + "] " + CRLF
NEXT
cString += Space( nIndent ) + " | +- >> End Methods ------" + CRLF
cString += Space( nIndent ) + " | " + CRLF
ENDIF
ENDIF
IF Empty( cString )
cString := Space( nIndent ) + " | " + CRLF
ENDIF
RETURN cString
IF Len( aProps ) > 0
cString += Space( nIndent ) + " | +- >> Begin Data ------" + CRLF
FOR EACH xProp IN aProps
cString += Space( nIndent ) + " | +- " + PadR( xProp[ HB_OO_DATA_SYMBOL ], 20 ) + " [" + DecodeType( xProp[ HB_OO_DATA_TYPE ] ) + "] [" + DecodeScope( xProp[ HB_OO_DATA_SCOPE ] ) + "] " + ValType( xProp[ HB_OO_DATA_VALUE ] ) + " => " + AsString( xProp[ HB_OO_DATA_VALUE ] ) + CRLF
IF lRecursive .AND. ValType( xProp[ HB_OO_DATA_VALUE ] ) $ "AO"
cString += __HB_DumpVar( xProp[ HB_OO_DATA_VALUE ],, lRecursive, nIndent + 3, nRecursionLevel + 1, nMaxRecursionLevel ) + CRLF
ENDIF
NEXT
cString += Space( nIndent ) + " | +- >> End Data ------" + CRLF
cString += Space( nIndent ) + " | " + CRLF
ENDIF
IF Len( aMethods ) > 0
cString += Space( nIndent ) + " | +- >> Begin Methods ------" + CRLF
FOR EACH aMth IN aMethods
cString += Space( nIndent ) + " | +- " + PadR( aMth[HB_OO_DATA_SYMBOL], 20 ) + " [" + DecodeType( aMth[HB_OO_DATA_TYPE] ) + "]" + " [" + DecodeScope( aMth[HB_OO_DATA_SCOPE] ) + "] " + CRLF
NEXT
cString += Space( nIndent ) + " | +- >> End Methods ------" + CRLF
cString += Space( nIndent ) + " | " + CRLF
ENDIF
ENDIF
IF Empty( cString )
cString := Space( nIndent ) + " | " + CRLF
ENDIF
RETURN cString
STATIC FUNCTION DShowArray( aVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL xVal, nChar
LOCAL cString := ""
LOCAL xVal, nChar
LOCAL cString := ""
DEFAULT nIndent TO 0
DEFAULT nIndent TO 0
//TraceLog( "DShowArray: aVar, lRecursive", aVar, lRecursive )
//TraceLog( "DShowArray: aVar, lRecursive", aVar, lRecursive )
IF ValType( aVar ) == "A"
nChar := Len( LTrim( Str( Len( aVar ) ) ) ) // return number of chars to display that value
// i.e. if Len( aVar ) == 99, then nChar := 2
cString += Space( nIndent ) + "{" + CRLF
FOR EACH xVal IN aVar
cString += Space( nIndent ) + " ["+ LTrim( StrZero( HB_EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + CRLF
IF lRecursive .AND. ValType( xVal ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
ENDIF
NEXT
IF Len( aVar ) > 0
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
ENDIF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
IF ValType( aVar ) == "A"
nChar := Len( LTrim( Str( Len( aVar ) ) ) ) // return number of chars to display that value
// i.e. if Len( aVar ) == 99, then nChar := 2
cString += Space( nIndent ) + "{" + CRLF
FOR EACH xVal IN aVar
cString += Space( nIndent ) + " ["+ LTrim( StrZero( HB_EnumIndex(), nChar ) ) + "] => " + AsString( xVal ) + ", " + CRLF
IF lRecursive .AND. ValType( xVal ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
ENDIF
NEXT
IF Len( aVar ) > 0
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
ENDIF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
RETURN cString
RETURN cString
STATIC FUNCTION DShowHash( hVar, lRecursive, nIndent, nRecursionLevel, nMaxRecursionLevel )
LOCAL xVal, xKey, aKeys
LOCAL cString := ""
LOCAL xVal, xKey, aKeys
LOCAL cString := ""
DEFAULT nIndent TO 0
DEFAULT nIndent TO 0
//TraceLog( "DShowHash: hVar, ValType( hVar ), lRecursive", hVar, ValType( hVar ), ValToPrg( hVar ), lRecursive )
//TraceLog( "DShowHash: hVar, ValType( hVar ), lRecursive", hVar, ValType( hVar ), ValToPrg( hVar ), lRecursive )
IF ValType( hVar ) == "H"
aKeys := HGetKeys( hVar )
cString += Space( nIndent ) + "{" + CRLF
FOR EACH xKey IN aKeys
xVal := hVar[ xKey ]
cString += Space( nIndent ) + " ["+ LTrim( AsString( xKey ) ) + "] => " + AsString( xVal ) + ", " + CRLF
IF lRecursive .AND. ValType( xVal ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
ENDIF
NEXT
IF Len( aKeys ) > 0
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
ENDIF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
IF ValType( hVar ) == "H"
aKeys := hb_HGetKeys( hVar )
cString += Space( nIndent ) + "{" + CRLF
FOR EACH xKey IN aKeys
xVal := hVar[ xKey ]
cString += Space( nIndent ) + " ["+ LTrim( AsString( xKey ) ) + "] => " + AsString( xVal ) + ", " + CRLF
IF lRecursive .AND. ValType( xVal ) $ "AOH"
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
cString += __HB_DumpVar( xVal,, lRecursive, nIndent+3, nRecursionLevel + 1, nMaxRecursionLevel )
cString := SubStr( cString, 1, Len( cString )-2 ) + ", " + CRLF
ENDIF
NEXT
IF Len( aKeys ) > 0
cString := SubStr( cString, 1, Len( cString )-4 ) + CRLF
ENDIF
cString += Space( nIndent ) + "}" + CRLF
ENDIF
RETURN cString
RETURN cString
STATIC FUNCTION DecodeScope( nScope AS NUMERIC )
LOCAL cString := ""
LOCAL cString := ""
IF hb_BitAnd( nScope, HB_OO_CLSTP_EXPORTED ) # 0 // 1
cString += "Ex,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_EXPORTED ) # 0 // 1
cString += "Ex,"
ENDIF
#ifdef __XHARBOUR__
IF hb_BitAnd( nScope, HB_OO_CLSTP_PUBLISHED ) # 0 // 2
cString += "Pu,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_PUBLISHED ) # 0 // 2
cString += "Pu,"
ENDIF
#endif
IF hb_BitAnd( nScope, HB_OO_CLSTP_PROTECTED ) # 0 // 4
cString += "Pr,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_HIDDEN ) # 0 // 8
cString += "Hi,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_CTOR ) # 0 // 16
cString += "Ct,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_READONLY ) # 0 // 32
cString += "Ro,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_SHARED ) # 0 // 64
cString += "Sh,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_CLASS ) # 0 // 128
cString += "Cl,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_SUPER ) # 0 // 256
cString += "Su,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_PROTECTED ) # 0 // 4
cString += "Pr,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_HIDDEN ) # 0 // 8
cString += "Hi,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_CTOR ) # 0 // 16
cString += "Ct,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_READONLY ) # 0 // 32
cString += "Ro,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_SHARED ) # 0 // 64
cString += "Sh,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_CLASS ) # 0 // 128
cString += "Cl,"
ENDIF
IF hb_BitAnd( nScope, HB_OO_CLSTP_SUPER ) # 0 // 256
cString += "Su,"
ENDIF
IF cString[-1] == ","
cString := SubStr( cString, 1, Len(cString)-1 )
ENDIF
IF Right( cString, 1 ) == ","
cString := SubStr( cString, 1, Len(cString)-1 )
ENDIF
RETURN PadR( cString, 18 )
RETURN PadR( cString, 18 )
STATIC FUNCTION DecodeType( nType AS NUMERIC )
LOCAL cString := ""
LOCAL cString := ""
DO CASE
CASE nType == HB_OO_MSG_METHOD // 0
cString += "Method"
CASE nType == HB_OO_MSG_DATA // 1
cString += "Data"
CASE nType == HB_OO_MSG_CLASSDATA // 2
cString += "Clsdata"
CASE nType == HB_OO_MSG_INLINE // 3
cString += "Inline"
CASE nType == HB_OO_MSG_VIRTUAL // 4
cString += "Virtual"
CASE nType == HB_OO_MSG_SUPER // 5
cString += "Super"
CASE nType == HB_OO_MSG_ONERROR // 6
cString += "OnError"
CASE nType == HB_OO_MSG_DESTRUCTOR // 7
cString += "Destructor"
CASE nType == HB_OO_PROPERTY // 8
cString += "Property"
CASE nType == HB_OO_MSG_PROPERTY // 9
cString += "MsgPrp"
CASE nType == HB_OO_MSG_CLASSPROPERTY // 10
cString += "ClsPrp"
ENDCASE
DO CASE
CASE nType == HB_OO_MSG_METHOD // 0
cString += "Method"
CASE nType == HB_OO_MSG_DATA // 1
cString += "Data"
CASE nType == HB_OO_MSG_CLASSDATA // 2
cString += "Clsdata"
CASE nType == HB_OO_MSG_INLINE // 3
cString += "Inline"
CASE nType == HB_OO_MSG_VIRTUAL // 4
cString += "Virtual"
CASE nType == HB_OO_MSG_SUPER // 5
cString += "Super"
CASE nType == HB_OO_MSG_ONERROR // 6
cString += "OnError"
CASE nType == HB_OO_MSG_DESTRUCTOR // 7
cString += "Destructor"
CASE nType == HB_OO_PROPERTY // 8
cString += "Property"
CASE nType == HB_OO_MSG_PROPERTY // 9
cString += "MsgPrp"
CASE nType == HB_OO_MSG_CLASSPROPERTY // 10
cString += "ClsPrp"
ENDCASE
RETURN PadR( cString, 7 )
RETURN PadR( cString, 7 )
STATIC FUNCTION asString( x )
local v := ValType( x )
LOCAL v := ValType( x )
DO CASE
CASE v == "C"
@@ -340,4 +341,4 @@ STATIC FUNCTION asString( x )
RETURN cStr( x )
ENDCASE
RETURN x
RETURN x