Generic object dump example

This example demonstrates how the objecttype, objectnbs, and objectvar properties and methods can be used to dump the contents of an arbitrary instance.

# This function returns a text description of an instance as an array of strings in a text array# Child instances are dumped with an indentation of 5 charactersFunprog DUMP_INSTANCE(OBJ, TEXT)Value Instance OBJ Using OBJECTVariable Char TEXT()(1..)# Stack of instances being analyzed, to avoid infinite recursion (through APARENT property)Local Char VISITED(20)(1..) : Local Integer NBSEnd Func DUMP_ONE(OBJ, TEXT, 1, 0, VISITED, NBS)# Internal call to handle nested instancesFunprog DUMP_ONE(OBJ, TEXT, FIRST_INDEX, SP, VISITED, NBS)Value Instance OBJ Using OBJECTVariable Char TEXT()(1..), VISITED()(1..)Value Integer FIRST_INDEX, SPVariable Integer NBS# Internal variable declarationLocal Integer LINE, I, DIMENSION, VARTYPELocal Char DIMTXT(30), CURTRT(100)# Find the current script name (used for an evaluated Func)CURTRT=trtcouWhile instr(1,CURTRT,"/")<>0CURTRT=right$(CURTRT,instr(1,CURTRT,"/")+1)WendIf instr(1,CURTRT,"$")<>0 : CURTRT=left$(CURTRT,instr(1,CURTRT,"$")-1) : Endif# Test if the current instance is already on the visited stackIf find(OBJ.objecttype, VISITED(1..NBS))TEXT(FIRST_INDEX)=space$(SP)+"*** class"-OBJ.objecttype-"already analyzed"End FIRST_INDEXElseNBS+=1 : VISITED(NBS)=OBJ.objecttypeEndif# Write the header first (when an indentation is set, the class is nested)LINE=FIRST_INDEXTEXT(LINE)=string$(SP>0,space$(SP)+"Nested Class")+string$(SP=0,"Class")& -"description:"-OBJ.objecttype# Let's loop on the different properties of the current class instanceFor I=1 to OBJ.objectnbsLINE+=1# First evaluate the dimension and the typeDIMENSION=evalue("dim(OBJ."+OBJ.objectvar(I)+")")VARTYPE=evalue("type(OBJ."+OBJ.objectvar(I)+")")# Add the name of the property in the text arrayTEXT(LINE)=space$(SP+2)+OBJ.objectvar(I)+":"# If not a child instance, add a line of descriptionIf VARTYPE<>524TEXT(LINE)+=func DATATYPE(DIMENSION,VARTYPE)Else# If it is a child instance, check if it is a null pointer (and mention it)If evalue("OBJ."+OBJ.objectvar(I)+"=null")=1TEXT(LINE)-="Null pointer"# Otherwise, call recursively the analysis (and add 5 to the indentation parameter)ElseTEXT(LINE)-="Child class instance"+Func IFARRAY(DIMENSION)SP+=5LINE=evalue("Func "+CURTRT+".DUMP_ONE(OBJ."+OBJ.objectvar(I)+",TEXT,LINE+1,SP,VISITED,NBS)")SP-=5EndifEndifNext IEnd LINE# Returns a string containing the type and the dimensionFunprog DATATYPE(DIMENSION,VARTYPE)Value Integer DIMENSION,VATYPELocal Char RESULT(100)Case VARTYPEWhen 1: End "Byte"+Func IFARRAY(DIMENSION)When 2: End "Short Integer"+Func IFARRAY(DIMENSION)When 3: End "Date"+Func IFARRAY(DIMENSION)When 4: End "Integer"+Func IFARRAY(DIMENSION)When 5: End "Floating point"+Func IFARRAY(DIMENSION)When 6: End "Double floating point"+Func IFARRAY(DIMENSION)When 7: End "Decimal value"+Func IFARRAY(DIMENSION)When 522 : End "Binary large object"+Func IFARRAY(DIMENSION)When 523 : End "Character large object"+Func IFARRAY(DIMENSION)When 525 : End "Unique ID"+Func IFARRAY(DIMENSION)When 526 : End "Date Time"+Func IFARRAY(DIMENSION)When 524 : End "Class Instance"+Func IFARRAY(DIMENSION)When Default : If VARTYPE>10 and VARTYPE<266End "String character ("+num$(VARTYPE)+")"+Func IFARRAY(DIMENSION)ElseEnd "Unknown data type"EndifEndcaseEnd# Returns the dimension in a textFunprog IFARRAY(DIMENSION)Value Integer DIMENSIONIf DIMENSION=32767End " array (variable dim)"ElseEnd string$(DIMENSION>1," array ("+num$(DIMENSION)+")")EndifEnd ""