harbour-core/harbour/contrib/xhb/cstruct.prg

/*
 * $Id$
 */

/*
 * xHarbour Project source code:
 * C Structure Support.
 *
 * Copyright 2000 Ron Pinkas <ronpinkas@profit-master.com>
 * 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 "cstruct.ch"
#include "hboo.ch"
#include "error.ch"

#define CLASS_PROPERTIES 6

THREAD STATIC t_aActiveStructure

/* TOFIX: 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 )

   /* LOCAL oErr */
   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 reduefinition, by returning a FAKED Structure Array!
         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 )
         */

         // 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, s_aClasses[-1][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 )

   nID := aScan( s_aClasses, {| aClassInfo | aClassInfo[1] == cStructure } )

   IF nID == 0
      nID := aScan( s_aSynonyms, {|aSynonym| aSynonym[1] == cStructure } )
      IF nID == 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
       // *** PP bug - remove when possible! ***
       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( s_aSynonyms[-1][1], s_aSynonyms[-1][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( s_aSynonyms[-1][1], s_aSynonyms[-1][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 )
   nID        := aScan( s_aClasses, {| aClassInfo | aClassInfo[1] == cStructure } )

   IF nID == 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 [" + LTrim( Str( nLen ) ) + "] CType: " + Str( CType )

   nID := aScan( s_aArrayClasses, {| aArrayDefinitions | aArrayDefinitions[1] == CType .AND. aArrayDefinitions[2] == nLen } )

   IF nID == 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 := LTrim( Str( 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

   //QOut( cPad + SubStr( QSelf():ClassName, 13 ) )
   //QOut( cPad + Replicate( "-", Len( SubStr( QSelf():ClassName, 13 ) ) ) )

   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()

   //LOCAL aValues := {}

   //aEval( QSelf(), {|xVal| aAdd( aValues, xVal ) }, 1, Len( QSelf() ) - CLASS_PROPERTIES )

   QSelf():InternalBuffer := HB_ArrayToStructure( QSelf(), QSelf():aCTypes, QSelf():nAlign )

   RETURN QSelf():InternalBuffer

//---------------------------------------------------------------------------//
STATIC FUNCTION DeValue( lAdopt )

   //LOCAL aValues := {}
   LOCAL Buffer := QSelf():InternalBuffer

   //TraceLog( QSelf():ClassName(), QSelf():nAlign, Buffer, Len( Buffer ), lAdopt )

   //aEval( QSelf(), {|xVal| aAdd( aValues, xVal ) }, 1, Len( QSelf() ) - CLASS_PROPERTIES )

   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