fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
harbour-core/contrib/xhb/cstruct.prg
Viktor Szakats 5a2a287752 2017-09-08 16:00 UTC Viktor Szakats (vszakats users.noreply.github.com) 
* *
    * partial sync with the 3.4 fork codebase. These are the things
      synces for the most part:
      - copyright headers
      - grammar/typos in comments and some readmes
      - comment/whitespace/decorations
      - variable scoping in C files
      - DO CASE/SWITCH and some other alternate syntax usage
      - minimal amount of human readable text in strings
      - minor code updates
      - HB_TRACE() void * casts for pointers and few other changes to
        avoid C compiler warnings
      - various other, minor code cleanups
      - only Harbour/C code/headers were touched in src, utils, contrib,
        include. No 3rd party code, no make files, and with just a few
        exceptions, no 'tests' code was touched.
      - certain components were not touched were 3.4 diverged too much
        already, like f.e. hbmk2, hbssl, hbcurl, hbexpat
      - the goal was that no actual program logic should be altered by
        these changes. Except some possible minor exceptions, any such
        change is probably a bug in this patch.
      It's a massive patch, if you find anything broken after it, please
      open an Issue with the details. Build test was done on macOS.
      The goal is make it easier to see what actual code/logic was changed
      in 3.4 compared to 3.2 and to make patches easier to apply in both
      ways.
2017-09-08 16:25:13 +00:00

620 lines
20 KiB
Plaintext
Raw Permalink Blame History

/*
* C Structure Support.
*
* Copyright 2000 Ron Pinkas <ronpinkas@profit-master.com>
*
* 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 program; see the file LICENSE.txt. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
*
* 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 "cstruct.ch"
#include "hboo.ch"
#include "error.ch"
#define CLASS_PROPERTIES 6
THREAD STATIC t_aActiveStructure
/* FIXME: Add mutex protection for variables below. */
STATIC s_aClasses := {}
STATIC s_aArrayClasses := {}
STATIC s_aSynonyms := {}
STATIC s_lInitLongs := .T.
PROCEDURE __init_LONGLONGs()
hb_CStructureCSyntax( "ULONGLONG", { "-4", "ulong[2]", }, , , 8 )
__ClsSetModule( __ActiveStructure() )
hb_CStructureCSyntax( "LONGLONG", { "4", "long[2]", }, , , 8 )
__ClsSetModule( __ActiveStructure() )
RETURN
FUNCTION __ActiveStructure( cStructure, nAlign )
#if 0
LOCAL oErr
#endif
LOCAL acMembers, aCTypes, hClass, Counter, cMember
IF s_lInitLongs
s_lInitLongs := .F.
__init_LONGLONGs()
ENDIF
IF PCount() == 2
cStructure := Upper( cStructure )
IF AScan( s_aClasses, {| aClassInfo | aClassInfo[ 1 ] == cStructure } ) > 0
/* In most cases we can simply ignore the redefinition, by returning a FAKED Structure Array! */
#if 0
oErr := ErrorNew()
oErr:Args := { cStructure, nAlign }
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
oErr:Description := "Structure already defined."
oErr:Operation := "__ActiveStructure()"
oErr:Severity := ES_ERROR
oErr:SubCode := 1
oErr:SubSystem := "C Structure"
RETURN Eval( ErrorBlock(), oErr )
#endif
// In most cases we can simply ignore the redefinition, by returning a FAKED Structure Array!
// TraceLog( "Redefinition of C Structure: " + cStructure )
RETURN t_aActiveStructure := { cStructure, NIL, {}, {}, iif( HB_ISNUMERIC( nAlign ), nAlign, 8 ) }
ENDIF
AAdd( s_aClasses, { cStructure, NIL, {}, {}, iif( HB_ISNUMERIC( nAlign ), nAlign, 8 ) } )
// TraceLog( "Registered: " + cStructure, ATail( s_aClasses )[ 5 ] )
t_aActiveStructure := ATail( s_aClasses )
ELSE
// TraceLog( "Created: " + Str( nId ) )
acMembers := t_aActiveStructure[ 3 ]
aCTypes := t_aActiveStructure[ 4 ]
nAlign := t_aActiveStructure[ 5 ]
hClass := __clsNew( "C Structure " + t_aActiveStructure[ 1 ], Len( acMembers ) + CLASS_PROPERTIES )
// __clsDelMsg( hClass, "C" )
t_aActiveStructure[ 2 ] := hClass
__clsAddMsg( hClass, "Reset" , @Reset() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Buffer" , @Buffer() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Value" , @Value() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "DeValue" , @DeValue() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Array" , @ArrayMethod() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "SayMembers", @SayMembers() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Init" , @Init() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Pointer" , @Pointer() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "GetPointer", @GetPointer() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "CopyTo" , @__CStr_CopyTo() , HB_OO_MSG_METHOD )
FOR EACH cMember IN acMembers
__clsAddMsg( hClass, cMember, cMember:__enumIndex(), HB_OO_MSG_PROPERTY )
NEXT
Counter := Len( acMembers )
__clsAddMsg( hClass, "aCTypes" , ++Counter, HB_OO_MSG_PROPERTY, acTypes )
__clsAddMsg( hClass, "aCMembers" , ++Counter, HB_OO_MSG_PROPERTY, acMembers, HB_OO_CLSTP_READONLY )
__clsAddMsg( hClass, "nAlign" , ++Counter, HB_OO_MSG_PROPERTY, nAlign, HB_OO_CLSTP_READONLY )
__clsAddMsg( hClass, "SizeOf" , ++Counter, HB_OO_MSG_PROPERTY, hb_SizeOfCstructure( aCTypes, nAlign ), HB_OO_CLSTP_READONLY )
__clsAddMsg( hClass, "_nID" , ++Counter, HB_OO_MSG_PROPERTY, Len( s_aClasses ) )
// WARNING InternalBuffer *MUST* remain the *LAST* Property!!!
__clsAddMsg( hClass, "InternalBuffer", ++Counter, HB_OO_MSG_PROPERTY, , HB_OO_CLSTP_READONLY )
// TraceLog( Len( aCTypes ), aCTypes[ 1 ], aCTypes )
RETURN hClass
ENDIF
RETURN t_aActiveStructure
PROCEDURE hb_Member( cMember, CType )
LOCAL nLen, nAt
IF Right( cMember, 1 ) == "]"
nAt := At( "[", cMember )
// nLen := Val( SubStr( cMember, nAt + 1, Len( cMember ) ) )
// Support expressions like x + y, x - y, x * y
nLen := &( SubStr( cMember, nAt + 1, Len( cMember ) - nAt - 1 ) )
AAdd( t_aActiveStructure[ 3 ], Left( cMember, nAt - 1 ) )
AAdd( t_aActiveStructure[ 4 ], hb_CTypeArrayId( CType, nLen ) )
ELSE
AAdd( t_aActiveStructure[ 3 ], cMember )
AAdd( t_aActiveStructure[ 4 ], CType )
ENDIF
RETURN
FUNCTION hb_CStructureId( cStructure, lInplace )
LOCAL nID
LOCAL oErr
cStructure := Upper( cStructure )
IF ( nID := AScan( s_aClasses, {| aClassInfo | aClassInfo[ 1 ] == cStructure } ) ) == 0
IF ( nID := AScan( s_aSynonyms, {| aSynonym | aSynonym[ 1 ] == cStructure } ) ) == 0
oErr := ErrorNew()
oErr:Args := { cStructure, lInplace }
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
oErr:Description := "Structure not found: '" + cStructure + "'"
oErr:Operation := "hb_CStructureId()"
oErr:Severity := ES_ERROR
oErr:SubCode := 3
oErr:SubSystem := "C Structure"
RETURN Eval( ErrorBlock(), oErr )
ELSE
nID := s_aSynonyms[ nID ][ 2 ]
ENDIF
nID += iif( lInplace, 0, CTYPE_STRUCTURE_PTR - CTYPE_STRUCTURE )
ELSE
nID += iif( lInplace, CTYPE_STRUCTURE, CTYPE_STRUCTURE_PTR )
ENDIF
// TraceLog( cStructure, nID )
RETURN nID
PROCEDURE hb_CStructureCSyntax( cStructure, aDefinitions, cTag, cSynonList, nAlign )
LOCAL cElem, nAt, nIndex := 1
LOCAL nLen, Counter, CType
LOCAL oErr
LOCAL nID, cSynon
FOR EACH cElem IN aDefinitions
IF cElem == NIL
ASize( aDefinitions, nIndex - 1 )
EXIT
ENDIF
IF ( nAt := At( "*", cElem ) ) > 1
IF nIndex < Len( aDefinitions )
hb_AIns( aDefinitions, nIndex + 1, SubStr( cElem, nAt + 1 ), .T. )
ELSE
AAdd( aDefinitions, SubStr( cElem, nAt + 1 ) )
ENDIF
aDefinitions[ nIndex ] := StrTran( Left( cElem, nAt ), " " )
ELSEIF ( nAt := At( "-", cElem ) ) > 1
IF nIndex < Len( aDefinitions )
hb_AIns( aDefinitions, nIndex + 1, SubStr( cElem, nAt ), .T. )
ELSE
AAdd( aDefinitions, SubStr( cElem, nAt ) )
ENDIF
aDefinitions[ nIndex ] := RTrim( Left( cElem, nAt - 1 ) )
ENDIF
nIndex++
NEXT
__ActiveStructure( cStructure, nAlign )
nID := Len( s_aClasses )
IF ! Empty( cTag )
AAdd( s_aSynonyms, { Upper( cTag ), nID + CTYPE_STRUCTURE } )
// TraceLog( ATail( s_aSynonyms )[ 1 ], ATail( s_aSynonyms )[ 2 ] )
ENDIF
IF ! Empty( cSynonList )
FOR EACH cSynon IN hb_ATokens( cSynonList )
IF Left( cSynon, 1 ) == "*"
AAdd( s_aSynonyms, { Upper( SubStr( cSynon, 2 ) ), nID + CTYPE_STRUCTURE_PTR } )
ELSE
AAdd( s_aSynonyms, { Upper( cSynon ), nID + CTYPE_STRUCTURE } )
ENDIF
// TraceLog( ATail( s_aSynonyms )[ 1 ], ATail( s_aSynonyms )[ 2 ] )
NEXT
ENDIF
nLen := Len( aDefinitions )
FOR Counter := 1 TO nLen STEP 2
// TraceLog( "Member: " + aDefinitions[ Counter + 1 ], "Type: " + aDefinitions[ Counter ] )
CType := aDefinitions[ Counter ]
IF Val( CType ) != 0
hb_Member( aDefinitions[ Counter + 1 ], Val( aDefinitions[ Counter ] ) )
ELSE
IF Right( CType, 1 ) == "*"
CType := hb_CStructureId( Left( CType, Len( CType ) - 1 ), .F. )
ELSE
CType := hb_CStructureId( CType, .T. )
IF CType == CTYPE_STRUCTURE .OR. CType == CTYPE_STRUCTURE_PTR
oErr := ErrorNew()
oErr:Args := { cStructure, aDefinitions, cTag, cSynonList, nAlign }
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
oErr:Description := "Undefined CType: '" + aDefinitions[ Counter ] + "'"
oErr:Operation := "hb_CStructureCSyntax()"
oErr:Severity := ES_ERROR
oErr:SubCode := 2
oErr:SubSystem := "C Structure"
CType := Eval( ErrorBlock(), oErr )
ENDIF
ENDIF
hb_Member( aDefinitions[ Counter + 1 ], CType )
ENDIF
NEXT
RETURN
FUNCTION hb_CStructure( cStructure, nAlign )
LOCAL hClass
LOCAL oStructure
LOCAL nID
LOCAL oErr
cStructure := Upper( cStructure )
IF ( nID := AScan( s_aClasses, {| aClassInfo | aClassInfo[ 1 ] == cStructure } ) ) == 0
oErr := ErrorNew()
oErr:Args := { cStructure, nAlign }
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
oErr:Description := "Structure not initialized with __ActiveStructure()"
oErr:Operation := "hb_CStructure()"
oErr:Severity := ES_ERROR
oErr:SubCode := 3
oErr:SubSystem := "C Structure"
RETURN Eval( ErrorBlock(), oErr )
ENDIF
hClass := s_aClasses[ nId ][ 2 ]
oStructure := __clsInst( hClass )
AllocateMembers( oStructure )
RETURN oStructure
STATIC PROCEDURE AllocateMembers( oStructure )
LOCAL aCTypes, CType
aCTypes := oStructure:aCTypes
// TraceLog( "Scaning: " + oStructure:className() )
FOR EACH CType IN aCTypes
IF CType > CTYPE_STRUCTURE .AND. CType < CTYPE_STRUCTURE_PTR
oStructure[ CType:__enumIndex() ] := hb_CStructureFromId( CType, , .F. )
AllocateMembers( oStructure[ CType:__enumIndex() ] )
ENDIF
NEXT
// TraceLog( "Finished: " + oStructure:className() )
RETURN
FUNCTION hb_CStructureFromId( nID, nAlign )
LOCAL hClass, oStructure
LOCAL oErr
// TraceLog( nId, s_aClasses )
IF nID > CTYPE_STRUCTURE_PTR
nID -= CTYPE_STRUCTURE_PTR
ELSEIF nID > CTYPE_STRUCTURE
nID -= CTYPE_STRUCTURE
ELSE
oErr := ErrorNew()
oErr:Args := { nID, nAlign }
oErr:CanDefault := .F.
oErr:CanRetry := .F.
oErr:CanSubstitute := .T.
oErr:Description := "ID out of range."
oErr:Operation := "hb_CStructureFromId()"
oErr:Severity := ES_ERROR
oErr:SubCode := 4
oErr:SubSystem := "C Structure"
RETURN Eval( ErrorBlock(), oErr )
ENDIF
IF s_aClasses[ nID ][ 2 ] == NIL
// Meta class was not created yet.
RETURN hb_CStructure( s_aClasses[ nId ][ 1 ] )
ELSE
hClass := s_aClasses[ nId ][ 2 ]
oStructure := __clsInst( hClass )
ENDIF
RETURN oStructure
FUNCTION hb_CTypeArrayId( CType, nLen )
LOCAL hClass
LOCAL Counter
LOCAL nID
LOCAL aCTypes, acMembers, cMember
LOCAL cArrayClassName := "C Array of [" + hb_ntos( nLen ) + "] CType: " + Str( CType )
IF ( nID := AScan( s_aArrayClasses, {| aArrayDefinitions | aArrayDefinitions[ 1 ] == CType .AND. aArrayDefinitions[ 2 ] == nLen } ) ) == 0
hClass := __clsNew( "C Structure " + cArrayClassName, nLen + CLASS_PROPERTIES )
// __clsDelMsg( hClass, "C" )
__ClsSetModule( hClass )
AAdd( s_aClasses, { cArrayClassName, hClass, Array( nLen ), Array( nLen ), 1 } )
nID := Len( s_aClasses )
acMembers := s_aClasses[ nID ][ 3 ]
aCTypes := s_aClasses[ nID ][ 4 ]
// Sames as s_aClasses[ nID ][ 4 ]
AFill( aCTypes, CType )
AAdd( s_aArrayClasses, { CType, nLen, nID } )
__clsAddMsg( hClass, "Reset" , @Reset() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Buffer" , @Buffer() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Value" , @Value() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "DeValue" , @DeValue() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Array" , @ArrayMethod() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "SayMembers", @SayMembers() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Init" , @Init() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "Pointer" , @Pointer() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "GetPointer", @GetPointer() , HB_OO_MSG_METHOD )
__clsAddMsg( hClass, "CopyTo" , @__CStr_CopyTo() , HB_OO_MSG_METHOD )
// IF Abs( CType ) == 1
__clsAddMsg( hClass, "AsString", @AsString(), HB_OO_MSG_METHOD )
// ENDIF
FOR Counter := 1 TO nLen
cMember := hb_ntos( Counter )
acMembers[ Counter ] := cMember
__clsAddMsg( hClass, cMember, Counter, HB_OO_MSG_PROPERTY )
NEXT
__clsAddMsg( hClass, "aCTypes" , Counter++, HB_OO_MSG_PROPERTY, aCTypes )
__clsAddMsg( hClass, "aCMembers" , Counter++, HB_OO_MSG_PROPERTY, acMembers, HB_OO_CLSTP_READONLY )
__clsAddMsg( hClass, "nAlign" , Counter++, HB_OO_MSG_PROPERTY, 1, HB_OO_CLSTP_READONLY )
__clsAddMsg( hClass, "SizeOf" , Counter++, HB_OO_MSG_PROPERTY, hb_SizeOfCstructure( aCTypes, 1 ), HB_OO_CLSTP_READONLY )
__clsAddMsg( hClass, "_nID", Counter++, HB_OO_MSG_PROPERTY, nID )
// WARNING InternalBuffer *MUST* remain the *LAST* Property!!!
__clsAddMsg( hClass, "InternalBuffer", Counter, HB_OO_MSG_PROPERTY, , HB_OO_CLSTP_READONLY )
// TraceLog( "Registered: " + cArrayClassName, nID, Len( s_aArrayClasses ), hb_SizeOfCstructure( aCTypes, 1 ), nLen )
ELSE
nID := s_aArrayClasses[ nID ][ 3 ]
// TraceLog( "Reused: " + s_aClasses[ nID ][ 1 ], nID )
ENDIF
RETURN nID + CTYPE_STRUCTURE
FUNCTION hb_Is_CStructure( x )
RETURN Left( x:ClassName(), 11 ) == "C Structure"
STATIC FUNCTION SayMembers( cPad, lShowMembers, lReturnString )
LOCAL xProperty, cOut := ""
IF cPad == NIL
cPad := ""
ENDIF
IF lShowMembers == NIL
lShowMembers := .F.
ENDIF
IF lReturnString == NIL
lReturnString := .F.
ENDIF
#if 0
QOut( cPad + SubStr( QSelf():className(), 13 ) )
QOut( cPad + Replicate( "-", Len( SubStr( QSelf():className(), 13 ) ) ) )
#endif
cOut += cPad + SubStr( QSelf():className(), 13 )
cOut += hb_eol() + cPad + Replicate( "-", Len( SubStr( QSelf():className(), 13 ) ) )
FOR EACH xProperty IN QSelf():Array
IF hb_Is_CStructure( xProperty )
IF lReturnString
cOut += hb_eol() + hb_eol() + xProperty:SayMembers( cPad + cPad, lShowMembers, lReturnString )
ELSE
xProperty:SayMembers( cPad + cPad, lShowMembers )
ENDIF
ELSE
// QOut( cPad + iif( lShowMembers, acMembers[ xProperty:__enumIndex() ], "" ) + ":", xProperty )
cOut += hb_eol() + cPad + iif( lShowMembers, QSelf():acMembers[ xProperty:__enumIndex() ], "" ) + ":" + hb_CStr( xProperty )
ENDIF
NEXT
IF ! lReturnString
QOut( cOut )
ENDIF
RETURN iif( lReturnString, cOut, QSelf() )
STATIC FUNCTION Reset()
LOCAL xProperty, nProperties := Len( QSelf() ) - CLASS_PROPERTIES
FOR EACH xProperty IN QSelf()
IF xProperty:__enumIndex() > nProperties
EXIT
ENDIF
IF hb_Is_CStructure( xProperty )
xProperty:Reset()
ELSE
xProperty := NIL
ENDIF
NEXT
RETURN QSelf()
STATIC FUNCTION Buffer( Buffer, lAdopt )
IF HB_ISSTRING( Buffer )
IF Len( Buffer ) < QSelf():SizeOf
// TraceLog( Buffer )
Buffer := PadR( Buffer, QSelf():SizeOf, Chr( 0 ) )
ENDIF
QSelf():InternalBuffer := Buffer
QSelf():DeValue( lAdopt )
ENDIF
IF ! HB_ISSTRING( QSelf():InternalBuffer )
QSelf():InternalBuffer := QSelf():Value()
ENDIF
RETURN QSelf()
STATIC FUNCTION GetPointer()
QSelf():InternalBuffer := hb_ArrayToStructure( QSelf(), QSelf():aCTypes, QSelf():nAlign )
RETURN hb_String2Pointer( QSelf():InternalBuffer )
STATIC FUNCTION Value()
#if 0
LOCAL aValues := {}
AEval( QSelf(), {| xVal | AAdd( aValues, xVal ) }, 1, Len( QSelf() ) - CLASS_PROPERTIES )
#endif
QSelf():InternalBuffer := hb_ArrayToStructure( QSelf(), QSelf():aCTypes, QSelf():nAlign )
RETURN QSelf():InternalBuffer
STATIC FUNCTION DeValue( lAdopt )
#if 0
LOCAL aValues := {}
#endif
LOCAL Buffer := QSelf():InternalBuffer
#if 0
TraceLog( QSelf():ClassName(), QSelf():nAlign, Buffer, Len( Buffer ), lAdopt )
AEval( QSelf(), {| xVal | AAdd( aValues, xVal ) }, 1, Len( QSelf() ) - CLASS_PROPERTIES )
#endif
IF ! HB_ISSTRING( Buffer ) .OR. Len( Buffer ) == 0
// TraceLog( "EMPTY Buffer passed to " + ProcName() )
ELSEIF Len( Buffer ) < QSelf():SizeOf
// TraceLog( "Should have been caught at ::Buffer()!!!", Buffer )
// Buffer := PadR( Buffer, QSelf():SizeOf, Chr( 0 ) )
ELSE
hb_StructureToArray( Buffer, QSelf():aCTypes, QSelf():nAlign, lAdopt, QSelf() )
ENDIF
RETURN QSelf()
STATIC FUNCTION ArrayMethod()
LOCAL aValues := {}
AEval( QSelf(), {| xVal | AAdd( aValues, xVal ) }, 1, Len( QSelf() ) - CLASS_PROPERTIES )
RETURN aValues
STATIC FUNCTION Init( aValues )
LOCAL xProperty, nLen := Len( aValues )
FOR EACH xProperty IN QSelf()
IF xProperty:__enumIndex() > nLen
EXIT
ENDIF
IF Left( xProperty:className(), 11 ) == "C Structure"
xProperty:Init( aValues[ xProperty:__enumIndex() ] )
ELSE
xProperty := aValues[ xProperty:__enumIndex() ]
ENDIF
NEXT
RETURN QSelf()
STATIC FUNCTION Pointer( nNewPointer, lAdopt )
IF nNewPointer != NIL
QSelf():Buffer( hb_Pointer2String( nNewPointer, QSelf():SizeOf ), lAdopt )
ENDIF
RETURN QSelf()
STATIC FUNCTION AsString()
LOCAL cChar, nLen := Len( QSelf() ) - CLASS_PROPERTIES, cString := Space( nLen )
FOR EACH cChar IN QSelf()
IF cChar:__enumIndex() > nLen
EXIT
ENDIF
IF cChar == 0
cString := Left( cString, cChar:__enumIndex() - 1 )
EXIT
ENDIF
cString[ cChar:__enumIndex() ] := cChar
NEXT
RETURN cString
Reference in New Issue View Git Blame Copy Permalink