* harbour/include/hbset.h
* harbour/source/rtl/set.c
* changed recently added hb_set*() functions to hb_setGet*()
Please do not use these functions yet - it's possible that
they will be removed soon.
+ added hb_setGetL(), hb_setGetCPtr(), hb_setGetNI(), hb_setGetNL()
* harbour/contrib/libct/dattime2.c
* harbour/contrib/samples/date.c
* use hb_setGetCentury() instead of hb_setGetL( hb_set_century )
we do not have hb_set_century SET switch so hb_setGetL() cannot
be used
* harbour/harbour.spec
* harbour/bin/hb-func.sh
* harbour/bin/pack_src.sh
* harbour/contrib/Makefile
+ harbour/contrib/xhb
+ harbour/contrib/xhb/hboutdbg.c
+ harbour/contrib/xhb/cstruct.ch
+ harbour/contrib/xhb/hblog.prg
+ harbour/contrib/xhb/hblog.ch
+ harbour/contrib/xhb/hblognet.prg
+ harbour/contrib/xhb/hbxml.c
+ harbour/contrib/xhb/hbxml.h
+ harbour/contrib/xhb/hbxml.ch
+ harbour/contrib/xhb/hblogdef.ch
+ harbour/contrib/xhb/hbctypes.ch
+ harbour/contrib/xhb/wintypes.ch
+ harbour/contrib/xhb/txml.prg
+ harbour/contrib/xhb/hbsyslog.c
+ harbour/contrib/xhb/cstructc.c
+ harbour/contrib/xhb/Makefile
+ harbour/contrib/xhb/cstruct.prg
+ harbour/contrib/xhb/xhbfunc.c
+ added XHB library with xharbour compatible functions borrowed from
xHarbour. Now it contains HBLOG, HBXML, HBCSTRUCT, HASH, INET*()
functions and classes.
* harbour/source/rtl/itemseri.c
* harbour/source/rtl/strmatch.c
* harbour/source/rtl/hbinet.c
* harbour/source/vm/hashfunc.c
* moved xHarbour compatible functions to XHB library
* harbour/source/vm/classes.c
+ added support for ERROR HANDLER message in scalar classes
* harbour/contrib/tip/mail.prg
* harbour/contrib/tip/ftpcln.prg
+ added #include "hbcompat.ch"
* harbour/include/hbdbferr.h
+ added new RT errors: EDBF_CREATE_TEMP, EDBF_WRITE_TEMP, EDBF_READ_TEMP
* harbour/include/dbinfo.ch
+ added DBI_ENCRYPT, DBI_DECRYPT, DBI_MEMOPACK, DBI_DIRTYREAD
+ added DBOI_INDEXTYPE, DBOI_USECURRENT
+ added RDDI_LOCKRETRY, RDDI_DIRTYREAD
* harbour/include/dbinfo.ch
* harbour/include/hbrdddbf.h
* harbour/include/hbrddfpt.h
* harbour/include/hbrddcdx.h
* harbour/include/hbrddntx.h
* harbour/source/rdd/dbf1.c
* harbour/source/rdd/dbffpt/dbffpt1.c
* harbour/source/rdd/dbfntx/dbfntx1.c
* harbour/source/rdd/dbfcdx/dbfcdx1.c
+ added support for MEMOPACK, table ENCRYPT/DECRYPT, index DIRTYREAD
* harbour/include/hbapirdd.h
* harbour/include/dbstruct.ch
* harbour/include/hbusrrdd.ch
* harbour/contrib/rdd_ads/ads1.c
* harbour/contrib/rdd_ads/ace.h
* harbour/source/rdd/dbfdbt/dbfdbt1.c
* harbour/source/rdd/dbffpt/dbffpt1.c
* harbour/source/rdd/dbcmd.c
* harbour/source/rdd/wafunc.c
* harbour/source/rdd/workarea.c
* harbour/source/rdd/dbf1.c
* harbour/source/rdd/sdf1.c
* harbour/source/rdd/delim1.c
* changed HB_IT_* as field type to HB_FT_*
+ added field flags HB_FF_*
+ added support for new field types to core code
* harbour/source/rdd/dbf1.c
+ added support for AUTOINC (+), ROWVERSION (^), TIME (T), DAYTIME (@)
and MODTIME (=) fields
* harbour/contrib/rdd_ads/ads1.c
* harbour/contrib/rdd_ads/ace.h
+ added support for ROWVERSION (^), and MODTIME (=) fields
! harbour/source/rdd/dbcmd.c
* fixed bug in dbSkipper() reported by Viktor
+ harbour/include/hbsix.ch
* harbour/source/rdd/hbsix/Makefile
* harbour/source/rdd/hbsix/sxdate.c
* harbour/source/rdd/hbsix/sxcompr.c
* harbour/source/rdd/hbsix/sxcrypt.c
+ harbour/source/rdd/hbsix/sxsem.c
+ harbour/source/rdd/hbsix/sxord.c
+ harbour/source/rdd/hbsix/sxredir.c
+ harbour/source/rdd/hbsix/sxfname.c
+ harbour/source/rdd/hbsix/sxtable.c
+ harbour/source/rdd/hbsix/sxutil.c
+ harbour/source/rdd/hbsix/sxcompat.prg
+ harbour/source/rdd/hbsix/sxtrig.prg
+ harbour/source/rdd/hbsix/sxini.prg
+ added SIx3 compatible functions:
RDD_Count(), RDD_Name(), RDD_Info(), SetRDD(),
sxChar(), sxNum(), sxDate(), sxLog(),
Sx_DToP(), Sx_PToD(),
Sx_BLOB2File(), Sx_File2BLOB(),
Sx_Compress(), Sx_Decompress(),
Sx_FCompress(), Sx_FDecompress(),
Sx_AutoOpen(), Sx_AutoShare(),
Sx_MemoExt(), Sx_MemoBlk(), Sx_SetMemoBlock(), Sx_MemoPack(),
Sx_SetTrigger(), Sx_SetTrig(), Sx_DefTrigger(),
Sx_INIheader(), _sx_INIinit(), _sxOpenInit(),
Sx_SetPass(),
Sx_Encrypt(), Sx_Decrypt(), Sx_DBFdecrypt(), Sx_DBFencrypt(),
sx_MakeSem(), sx_KillSem(), sx_IsSem(),
Sx_ClrScope(), Sx_SetScope(),
Sx_Freeze(), Sx_Warm(), Sx_Chill(), Sx_Thermometer(),
Sx_IsReindex(), Sx_Step(), Sx_KeysIncluded(),
Sx_I_IndexName(), Sx_I_TagName(),
Sx_IndexCount(), Sx_IndexName(), Sx_IndexType(), Sx_IndexFilter(),
Sx_ROXLock(), Sx_ROXUnLock(), Sx_IsMyROX(), Sx_IsROXLock(),
Sx_KeyAdd(), Sx_KeyDrop(), Sx_KeyData(),
Sx_KeySkip(), Sx_KeyCount(), Sx_KeyNo(), Sx_KeyGoto(),
Sx_WildSeek(), Sx_WildMatch(),
Sx_IsFLocked(), Sx_IsReadOnly(), Sx_IsShared(),
Sx_IsLocked(), Sx_IsDBT(),
Sx_IDtype(), Sx_TableType(), Sx_TableName(),
Sx_SetTurbo(), Sx_TurboArea(), Sx_SetDirty(), Sx_DirtyArea(),
Sx_RLock(), Sx_UnLock(), Sx_GetLocks(), Sx_LockRetry(),
Sx_SeekLast(), Sx_FindRec(),
Sx_SkipUnique(), Sx_TagUnique(),
Sx_TagCount(), Sx_TagOrder(), Sx_TagNo(), Sx_TagName(),
Sx_TagInfo(), Sx_Tags(),
Sx_SetTag(), Sx_SetTagOrder(), Sx_SetTagNo(),
Sx_KillTag(),
Sx_FileOrder(), Sx_SetFileOrd(), Sx_ClearOrder(),
Sx_VSigLen(), Sx_VFGet(),
Sx_dbCreate(), Sx_StrxCheck(), Sx_Rollback(), Sx_SortOption(),
_sxCondSet(),
Sx_FNameParser(), Sx_SlimFast(),
Sx_Version(), Sx_Error(),
+ added SIx3 compatible commands:
SET DIRTYREAD ON|OFF
USE ... [TRIGGER <cTrigger>] [PASSWORD <cPassword>]
SORT ... USECURRENT
WILDSEEK <str>
WILDSEEKNEXT <str>
CLEAR ORDER <order>
SET TAGORDER TO [<order>]
SET ORDER TO TAG <(tag)> [OF <(bag)>]
SET TAG TO [<tag> [OF <(bag)>]]
REINDEX OPTION <eval> [STEP <step>]
DELETE TAG <(tag1)> [OF <(bag1)>] [, <(tagN)> [OF <(bagN)>]]
DELETE TAG ALL [OF <(bag)>]
CLEAR SCOPE
SET SCOPETOP TO [<value>]
SET SCOPEBOTTOM TO [<value>]
SET SCOPE TO [<value>]
SET TURBOREAD ON|OFF
MEMOPACK [BLOCK <size>] [OPTION <opt> [STEP <step>]]
SET MEMOBLOCK TO <value>
SUBINDEX ON <key> TO <(file)> ;
[OPTION <eval> [STEP <every>]] [FILTERON] [EMPTY]
SUBINDEX ON <key> TAG <(tag)> [OF <(bag)>] [TO <(bag)>] ;
[OPTION <eval> [STEP <every>]] [FILTERON] [EMPTY]
INDEX ON <key> [TAG <(tag)>] TO <(bag)> ;
[OPTION <eval> [STEP <every>]] [FILTERON] [EMPTY] [SUBINDEX]
INDEX ON <key> TAG <(tag)> [OF <(bag)>] [TO <(bag)>] ;
[OPTION <eval> [STEP <every>]] [FILTERON] [EMPTY] [SUBINDEX]
Unlike Ads*() functions the Sx_*() ones can be used with any RDD
and will work if RDD supports necessary functionality.
The global settings in SIx3 are RDD dependent in Harbour, f.e.
in SIx3 Sx_MemoExt() change MEMO file extensions in all SIX* RDDs
but in Harbour only in default RDD driver.
In Harbour default trigger function "Sx_DefTrigger" is not
enabled by default. If user needs such functionality then he
has to enable it himself using
rddInfo( RDDI_TRIGGER, "SX_DEFTRIGGER", [<cRDD>] )
f.e. this code:
init procedure sx_inittrig()
local aRDDs := { "DBF", "DBFNTX", "DBFCDX", "SIXCDX", ;
"RMDBFNTX", "RMDBFCDX" }
local aRDDList := RddList(), cRdd
for each cRdd in aRDDs
if ascan( aRDDList, { |x| x == cRdd } ) != 0
rddInfo( RDDI_TRIGGER, "SX_DEFTRIGGER", cRDD )
endif
next
return
sets SX_DEFTRIGGER as default trigger in DBF* based RDDs.
I still do not allow to encrypt tables with memo fields to not
replicate SIx3 bugs which may cause data corruption.
641 lines
21 KiB
Plaintext
641 lines
21 KiB
Plaintext
/*
|
|
* $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
|
|
|
|
static s_aActiveStructure
|
|
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 ( s_aActiveStructure := { cStructure, NIL, {}, {}, IIF( ValType( nAlign ) == "N", nAlign, 8 ) } )
|
|
END
|
|
|
|
aAdd( s_aClasses, { cStructure, NIL, {}, {}, IIF( ValType( nAlign ) == "N", nAlign, 8 ) } )
|
|
//TraceLog( "Registered: " + cStructure, s_aClasses[-1][5] )
|
|
|
|
s_aActiveStructure := atail(s_aClasses)
|
|
ELSE
|
|
//TraceLog( "Created: " + Str( nId ) )
|
|
|
|
acMembers := s_aActiveStructure[3]
|
|
aCTypes := s_aActiveStructure[4]
|
|
nAlign := s_aActiveStructure[5]
|
|
|
|
hClass := __clsNew( "C Structure " + s_aActiveStructure[1] , Len( acMembers ) + CLASS_PROPERTIES )
|
|
//__clsDelMsg( hClass, "C" )
|
|
|
|
s_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 s_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( s_aActiveStructure[3], Left( cMember, nAt - 1 ) )
|
|
aAdd( s_aActiveStructure[4], HB_CTypeArrayID( CType, nLen ) )
|
|
ELSE
|
|
aAdd( s_aActiveStructure[3], cMember )
|
|
aAdd( s_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 )
|
|
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 )
|
|
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 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, lInplace
|
|
LOCAL oErr
|
|
|
|
//TraceLog( nId, s_aClasses )
|
|
|
|
IF nID > CTYPE_STRUCTURE_PTR
|
|
lInplace := .F.
|
|
nID -= CTYPE_STRUCTURE_PTR
|
|
ELSEIF nID > CTYPE_STRUCTURE
|
|
lInplace := .T.
|
|
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_OSNewLine() + cPad + Replicate( "-", Len( SubStr( QSelf():ClassName, 13 ) ) )
|
|
|
|
FOR EACH xProperty IN QSelf():Array
|
|
IF HB_IS_CStructure( xProperty )
|
|
IF lReturnString
|
|
cOut += hb_OSNewLine() + hb_OSNewLine() + xProperty:SayMembers( cPad + cPad, lShowMembers, lReturnString )
|
|
ELSE
|
|
xProperty:SayMembers( cPad + cPad, lShowMembers )
|
|
ENDIF
|
|
ELSE
|
|
//QOut( cPad + IIF( lShowMembers, acMembers[ xProperty:__enumIndex() ], "" ) + ":", xProperty )
|
|
cOut += hb_OSNewLine() + cPad + IIF( lShowMembers, QSelf():acMembers[ xProperty:__enumIndex() ], "" ) + ":" + hb_cStr( xProperty )
|
|
END
|
|
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
|
|
END
|
|
NEXT
|
|
|
|
RETURN QSelf()
|
|
|
|
//---------------------------------------------------------------------------//
|
|
STATIC Function Buffer( Buffer, lAdopt )
|
|
|
|
IF ValType( Buffer ) == "C"
|
|
IF Len( Buffer ) < QSelf():SizeOf
|
|
//TraceLog( Buffer )
|
|
Buffer := PadR( Buffer, QSelf():SizeOf, Chr(0) )
|
|
ENDIF
|
|
|
|
QSelf():InternalBuffer := Buffer
|
|
QSelf():DeValue( lAdopt )
|
|
ENDIF
|
|
|
|
IF ValType( QSelf():InternalBuffer ) != "C"
|
|
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 nLen := Len( QSelf() ) - CLASS_PROPERTIES
|
|
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 ValType( Buffer ) != "C" .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
|