cclassparser.prg

MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能

	
		
			*-- PROCEDURE, PROTECTED/HIDDEN PROCEDURE, FUNCTION, 
			*-- PROTECTED/HIDDEN FUNCTION
			IF NOT (UPPER(laWords[1]) = "PROCEDURE" OR (lnWords > 1 AND LEFT(laWords[1],1) # '*' AND UPPER(laWords[2]) = "PROCEDURE") OR ;
				UPPER(laWords[1]) = "FUNCTION" OR (lnWords > 1 AND LEFT(laWords[1],1) # '*' AND UPPER(laWords[2]) = "FUNCTION"))
			
				LOOP
			ENDIF
			
			*-- It's a boy!
			llRetVal 	= .T.
			lnMethods 	= lnMethods + 1
			llProtected = IIF(UPPER(laWords[1]) = "PROTECTED", .T., .F.)	
			llHidden    = IIF(UPPER(laWords[1]) = "HIDDEN", .T., .F.)	
			
			DIMENSION raMethods[lnMethods,5]
			IF llHidden OR llProtected
				raMethods[lnMethods,1] = laWords[3]
			ELSE
				raMethods[lnMethods,1] = laWords[2]
			ENDIF
			raMethods[lnMethods,2] = llProtected
			raMethods[lnMethods,3] = llHidden
			raMethods[lnMethods,4] = ""
			raMethods[lnMethods,5] = THIS.LineNumberToCharNumber(lnCount)
		ENDFOR			

		RETURN llRetVal
	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  GetNthGenerationClasses()
	*-------------------------------------------------------
	*) Description: Returns an array of nth generation classes.
	*)	Examples of nth generation: 1st generation classes are
	*)	root classes (classes that have no higher parents),
	*)	2nd generation classes are children of 1st generation
	*)	classes, 3rd generation classes are grand-children of 
	*)	1st generation classes, etc. Optionally, if 
	*)	tcFullFilename is passed only classes from a particular 
	*)	file will be returned.
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Numeric
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE GetNthGenerationClasses(tnLevel, raChildClasses, tcFullFilename)
		LOCAL lnRetVal, lnRecNo, lnLoop, lnLevel, ;
			lcParent, lcParentID, lcScanFor, lcFullFilename
		
		lnRetVal = 0
		lcFullFileName = IIF(EMPTY(tcFullFilename), "", ALLTRIM(tcFullFilename))
		lcScanFor = IIF(EMPTY(lcFullFilename), "!EMPTY(cn_classes.filenameex)", "ALLTRIM(cn_classes.filenameex) = lcFullFilename")
		SELECT cn_classes
		SET ORDER TO classname

		LOCATE
		SCAN FOR &lcScanFor
			lnRecNo = RECNO()
			lnLevel = 1
			lcParentKey = ""
			FOR lnLoop = 1 TO tnLevel
				lcParent = UPPER(cn_classes.parent)
				IF SEEK(lcParent, "cn_classes", "classname")
					IF lnLevel = 1
						lcParentKey = cn_classes.id
					ENDIF
					lnLevel = lnLevel + 1
					lcParent = UPPER(cn_classes.parent)
				ELSE
					EXIT
				ENDIF	
			ENDFOR
			IF lnLevel = tnLevel
				GO (lnRecNo)
				lnRetVal = lnRetVal + 1
				DIMENSION raChildClasses[lnRetVal,7]
				raChildClasses[lnRetVal,1] = cn_classes.id
				raChildClasses[lnRetVal,2] = ALLTRIM(cn_classes.classname)
				raChildClasses[lnRetVal,3] = ALLTRIM(cn_classes.parent)
				raChildClasses[lnRetVal,4] = lcParentKey
				raChildClasses[lnRetVal,5] = cn_classes.olepublic
				raChildClasses[lnRetVal,6] = cn_classes.startchar
				raChildClasses[lnRetVal,7] = ALLTRIM(cn_classes.filenameex)
			ELSE
				GO (lnRecNo)			
			ENDIF
		ENDSCAN
		
		RETURN lnRetVal
	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  GetMaxClassGeneration()
	*-------------------------------------------------------
	*) Description: Returns the maximum number of genrations
	*)	 the classes have. For example, if every
	*)	class is currently a root class, this number would
	*)	be 1. If there were at least one child class this
	*)	would be 2. If there were at least one grandchild
	*)	class this would be 3, etc. Optionally, if 
	*)	tcFullFilename is passed only classes from a 
	*)	particular file will be considered.
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Numeric
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE GetMaxClassGeneration(tcFullFilename)
		LOCAL lnRetVal, lnRecNo, lnLevel, lcParent, ;
			lcParentID, lcScanFor, lcFullFilename, ;
			lnMax
		
		lnRetVal = 1
		lcFullFileName = IIF(EMPTY(tcFullFilename), "", ALLTRIM(tcFullFilename))
		lcScanFor = IIF(EMPTY(lcFullFilename), "!EMPTY(cn_classes.filenameex)", "ALLTRIM(cn_classes.filenameex) = lcFullFilename")
		SELECT cn_classes
		SET ORDER TO

		LOCATE
		SCAN FOR &lcScanFor
			lnMax    = 1
			lnRecNo = RECNO()
			lcParentKey = ""
			DO WHILE .T.
				lcParent = UPPER(cn_classes.parent)
				IF SEEK(lcParent, "cn_classes", "classname")
					lnMax = lnMax + 1
				ELSE
					EXIT
				ENDIF	
			ENDDO
			lnRetVal = IIF(lnMax > lnRetVal, lnMax, lnRetVal)
			GO (lnRecNo)
		ENDSCAN
		
		RETURN lnRetVal
	ENDPROC
	*///////////////////////////////////////////////////////	


	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  GetClassByClassID()
	*-------------------------------------------------------
	*) Description: Populates the raClass parameter
	*)	with an array of class information. Returns .f. if
	*)	no class is found. The array has the following
	*)	structure:
	*)
	*)	aClass[1] = Class id
	*)	aClass[2] = Class name
	*)	aClass[3] = Parent id (if any)
	*)	aClass[4] = Parent name
	*)	aClass[5] = Olepublic
	*)	aClass[6] = Startchar (where in the prg the define class is)
	*)	aClass[7] = Filename
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE GetClassByClassID(tcClassID, raClass)
		LOCAL llRetVal, lcParent
		
		llRetVal = SEEK(tcClassID, "cn_classes", "id")
		IF llRetVal
			DIMENSION raClass[7]
			raClass[1] = cn_classes.id
			raClass[2] = ALLTRIM(cn_classes.classname)
			raClass[3] = ""
			raClass[4] = ALLTRIM(cn_classes.parent)
			raClass[5] = cn_classes.olepublic
			raClass[6] = cn_classes.startchar
			raClass[7] = ALLTRIM(cn_classes.filenameex)

			lcParent = UPPER(cn_classes.parent)
			IF SEEK(lcParent, "cn_classes", "classname")
				raClass[3] = ALLTRIM(cn_classes.id)
			ENDIF
		ENDIF
		
		RETURN llRetVal
	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  GetMethodByMethodID()
	*-------------------------------------------------------
	*) Description: Populates the raMethod parameter
	*)	with an array of method information. Returns .f. if 
	*)	no method is found. The array has the following
	*)	structure:
	*)
	*)	aMethod[1] = Method id
	*)	aMethod[2] = Method name
	*)	aMethod[3] = Class id 
	*)	aMethod[4] = Parameters
	*)	aMethod[5] = Protected
	*)	aMethod[6] = Hidden
	*)	aMethod[7] = Startchar
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE GetMethodByMethodID(tcMethodID, raMethod)
		LOCAL llRetVal
		
		llRetVal = SEEK(tcMethodID, "cn_methods", "id")
		IF llRetVal
			DIMENSION raMethod[7]
			raMethod[1] = cn_methods.id
			raMethod[2] = ALLTRIM(cn_methods.methname)
			raMethod[3] = cn_methods.classid
			raMethod[4] = ALLTRIM(cn_methods.parameters)
			raMethod[5] = cn_methods.protected
			raMethod[6] = cn_methods.hidden
			raMethod[7] = cn_methods.startchar
		ENDIF
		
		RETURN llRetVal
	ENDPROC
	*///////////////////////////////////////////////////////	
	
	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  GetChildClasses()
	*-------------------------------------------------------
	*) Description: Returns an array of child classes 
	*)	(subclasses).
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Numeric
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE GetChildClasses(tcClassID, raChildClasses)
		LOCAL lnRetVal, lcParent
		
		lnRetVal = 0
		SELECT cn_classes
		SET ORDER TO classname
		IF SEEK(tcClassID, "cn_classes", "id")
			lcParent = ALLTRIM(cn_classes.classname)
			SCAN FOR cn_classes.parent = lcParent
				lnRetVal = lnRetVal + 1
				DIMENSION raChildClasses[lnRetVal,7]
				raChildClasses[lnRetVal,1] = cn_classes.id
				raChildClasses[lnRetVal,2] = ALLTRIM(cn_classes.classname)
				raChildClasses[lnRetVal,3] = ALLTRIM(cn_classes.parent)
				raChildClasses[lnRetVal,4] = tcClassID
				raChildClasses[lnRetVal,5] = cn_classes.olepublic
				raChildClasses[lnRetVal,6] = cn_classes.startchar
				raChildClasses[lnRetVal,7] = ALLTRIM(cn_classes.filenameex)
			ENDSCAN
		ENDIF
		
		RETURN lnRetVal
	ENDPROC
	*///////////////////////////////////////////////////////	


	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  GetClassProperties()
	*-------------------------------------------------------
	*) Description: Returns an array of class properties
	*)	for a class
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Numeric
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE GetClassProperties(tcClassID, raClassProperties)
		LOCAL lnRetVal
		
		lnRetVal = 0
		SELECT cn_properties
		SET ORDER TO propname
		SCAN FOR cn_properties.classid = tcClassID
			lnRetVal = lnRetVal + 1
			DIMENSION raClassProperties[lnRetVal,6]
			raClassProperties[lnRetVal,1] = cn_properties.id
			raClassProperties[lnRetVal,2] = ALLTRIM(cn_properties.propname)
			raClassProperties[lnRetVal,3] = cn_properties.protected
			raClassProperties[lnRetVal,4] = cn_properties.hidden
			raClassProperties[lnRetVal,5] = cn_properties.value
			raClassProperties[lnRetVal,6] = cn_properties.startchar
		ENDSCAN