cclassparser.prg

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

		
		llRetVal = .F.
		
		lcSearchFor = "DEFINE CLASS "
		DIMENSION raClass[4]
		
		*-- Scan through each element looking for a "DEFINE CLASS"
		*-- make sure the expression appears at the beginning of the
		*-- element to make sure it is really a class definition and
		*-- not a commented definition or just the words appearing
		*-- in a comment.
		FOR lnCount	= THIS.nClassStartElement TO ALEN(THIS.aClassFile)
			IF LEFT(UPPER(THIS.aClassFile[lnCount]), LEN(lcSearchFor)) == lcSearchFor
				*-- We have the line of a class definition. Now we
				*-- need to pull out the class name, the parent class
				*-- name and whether is it OLEPUBLIC. Scan through
				*-- each character looking for spaces.

				llRetVal = .T.
				THIS.nClassStartElement = lnCount + 1
				
				lnWords = THIS.WordsToArray(THIS.aClassFile[lnCount], @laClassDef)
				
				*-- Each word in the line is now an element in the array. The
				*-- name of the class will be the 3rd element. The parent name
				*-- will be the 5th element. If there is a 6th element it
				*-- could be the OLEPUBLIC attribute. For this to be a valid
				*-- class definition there must be at least 5 words "DEFINE
				*-- CLASS XXXX AS XXXX"
				
				IF lnWords >= 5
					raClass[1] = laClassDef[3]
					raClass[2] = laClassDef[5]
					raClass[3] = IIF(lnWords > 5 AND UPPER(laClassDef[6]) = "OLEPUBLIC", .T., .F.)
					raClass[4] = THIS.LineNumberToCharNumber(lnCount)
				ENDIF
				
				*-- Find the line that the class definition ends. This could be an
				*-- ENDDEFINE or another DEFINE CLASS or the end of the file.
				lcSearchFor2 = "ENDDEFINE"
				FOR lnCount	= THIS.nClassStartElement TO ALEN(THIS.aClassFile)
	
					THIS.nLastClassCharCount = THIS.nLastClassCharCount + LEN(THIS.aClassFile[lnCount])		

					IF LEFT(UPPER(THIS.aClassFile[lnCount]), LEN(lcSearchFor)) == lcSearchFor OR ;
						LEFT(UPPER(THIS.aClassFile[lnCount]), LEN(lcSearchFor2)) == lcSearchFor2 OR ;
						lnCount = ALEN(THIS.aClassFile)
							THIS.nClassEndElement = lnCount
							EXIT
					ENDIF
				ENDFOR
				
				EXIT
			ELSE
				THIS.nLastClassCharCount = THIS.nLastClassCharCount + LEN(THIS.aClassFile[lnCount])		
			ENDIF
		ENDFOR

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


	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  FindPropertiesInClass()
	*-------------------------------------------------------
	*) Description:  Finds all the properties in the 
	*)	class pointed to by nClassStartElement and 
	*)	nClassEndElement
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE FindPropertiesInClass(raProperties)
		LOCAL llRetVal
		
		*-- Reset the raProperties array
		DIMENSION raProperties[1,5]
		STORE .F. to raProperties
		
		llRetVal = THIS.FindProtectedPropertiesInClass(@raProperties)
		llRetVal = THIS.FindFreePropertiesInClass(@raProperties) OR llRetVal 
		
		RETURN llRetVal
	ENDPROC
	
		
	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  FindProtectedPropertiesInClass()
	*-------------------------------------------------------
	*) Description:  Finds all the protected properties in 
	*)	the class pointed to by nClassStartElement and 
	*)	nClassEndElement
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE FindProtectedPropertiesInClass(raProperties)
		LOCAL llRetVal, lnCount, lnWords, laWords[1], ;
			llProtected, llHidden, lcString, ;
			laProperties[1], llContinueLine, lnLoop, ;
			lnProperties, lnPropCount

		llRetVal = .F.
		lnProperties = 0
		lnPropCount = 1
		lnLoopCount = 0
		
		*-- Scan through each element looking for a PROTECTED or
		*-- HIDDEN keyword. There can be multiple lines with these
		*-- keywords butthey will all appear before the first 
		*-- function or method. Also, a distinction has to be made 
		*-- between PROTECTED/HIDDEN properties and functions.
			FOR lnCount	= THIS.nClassStartElement TO THIS.nClassEndElement
				lnWords = THIS.WordsToArray(THIS.aClassFile[lnCount], @laWords)
		
			
				*-- If we see a procedure or function then we need to stop
				*-- looking for protected/hidden properties. So, check for
				*-- PROCEDURE, PROTECTED/HIDDEN PROCEDURE, FUNCTION, 
				*-- PROTECTED/HIDDEN FUNCTION
				IF 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")
				
					EXIT
				ENDIF
				
				*-- If it's less than 2 words it can't be a protected
				*-- property.
				IF lnWords < 2
					LOOP
				ENDIF
				
				*-- If it doesn't have a PROTECTED/HIDDEN keyword in
				*-- the beginning move to the next line.
				IF laWords[1] # "PROTECTED" AND laWords[1] # "HIDDEN"
					LOOP
				ENDIF

				*-- If we are here, we know that the line of code is not a
				*-- procedure or function and the first word is either
				*-- PROTECTED or HIDDEN. It must be a property list.
				llRetVal = .T.
				llProtected = IIF(UPPER(laWords[1]) = "PROTECTED", .T., .F.)	
				llHidden    = IIF(UPPER(laWords[1]) = "HIDDEN", .T., .F.)	

				*-- Remove the protected or hidden keyword from the line 
				*-- and change the list to an array.
				IF llProtected
					lcString = SUBSTR(ALLTRIM(THIS.aClassFile[lnCount]), LEN("PROTECTED "))
				ELSE && llHidden
					lcString = SUBSTR(ALLTRIM(THIS.aClassFile[lnCount]), LEN("HIDDEN "))
				ENDIF
				lnWords  = THIS.ListToArray(lcString, @laProperties)
				
				*-- Redimension the raProperties array. If the last "word"
				*-- in the laProperties array is a ";" dimension one less
				llContinueLine = IIF(laProperties[lnWords] = ";", .T., .F.)
				IF llContinueLine
					lnProperties = lnProperties + lnWords - 1
				ELSE
					lnProperties = lnProperties + lnWords
				ENDIF

				*-- Scan through the array adding each property to the
				*-- raProperties array 
				lnLoopCount = 0
				DIMENSION raProperties[lnProperties, 5]
				FOR lnLoop = lnPropCount TO lnProperties
					lnLoopCount = lnLoopCount + 1
					raProperties[lnLoop,1] = laProperties[lnLoopCount]
					raProperties[lnLoop,2] = llProtected
					raProperties[lnLoop,3] = llHidden
					raProperties[lnLoop,4] = ".F."
					raProperties[lnLoop,5] = lnCount
				ENDFOR
				lnPropCount = ALEN(raProperties,1) + 1
				
				*-- If llContinueLine is true then we have multiple lines
				*-- of PROTECTED/HIDDEN properties.
				DO WHILE llContinueLine					
					lnCount = lnCount + 1
					lnPropCount = ALEN(raProperties,1) + 1
					lcString = THIS.aClassFile[lnCount]
					lnWords  = THIS.ListToArray(lcString, @laProperties)
					llContinueLine = IIF(laProperties[lnWords] = ";", .T., .F.)
					IF llContinueLine
						lnProperties = lnProperties + lnWords - 1 
					ELSE
						lnProperties = lnProperties + lnWords 
					ENDIF
					DIMENSION raProperties[lnProperties, 5]

					*-- Scan through the array adding each property to the
					*-- raProperties array
					lnWordCount = 0
					FOR lnLoop = lnPropCount TO lnProperties
						lnWordCount = lnWordCount + 1
						raProperties[lnLoop,1] = laProperties[lnWordCount]
						raProperties[lnLoop,2] = llProtected
						raProperties[lnLoop,3] = llHidden
						raProperties[lnLoop,4] = ".F."
						raProperties[lnLoop,5] = lnCount
					ENDFOR
				ENDDO
			ENDFOR

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

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  FindFreePropertiesInClass()
	*-------------------------------------------------------
	*) Description:  Finds "free" properties in the class
	*)	pointed to by nClassStartElement and nClassEndElement.
	*)	A free property is a property that appears somewhere
	*)	in the class header (between the beginning of the class 
	*)	definition and either the end of the class or the first 
	*)	method/function, whichever comes first. Basically, 
	*)	any line in the class header that has an "=" in it
	*)	is a property definition.
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE FindFreePropertiesInClass(raProperties)
		LOCAL llRetVal, lnCount, lnWords, laWords[1], lcProperty, ;
			lnElement, lnRow, lnRowCount
		
		llRetVal = .F.
		*-- Scan through each element looking for an
		*-- "=". Everything to the left of the = is
		*-- the property name, everything to the 
		*-- right is the property default value.
		FOR lnCount	= THIS.nClassStartElement TO THIS.nClassEndElement
			lnWords = THIS.WordsToArray(THIS.aClassFile[lnCount], @laWords)
	
		
			*-- If we see a procedure or function then we need to stop
			*-- looking for properties since they can only appear in 
			*-- the class header.
			IF 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")
			
				EXIT
			ENDIF
		
			*-- If the first words is a comment or the second word is 
			*-- not an = it can't be a property
			IF lnWords < 3 OR LEFT(laWords[1],1) = "*" OR laWords[2] # "="
				LOOP
			ENDIF

			*-- We have a weener. See if this property is already in the
			*-- raProperties array. If it is, add the property value to 
			*-- the existing element. If it isn't, add a new row to
			*-- the array and add the info.
			llRetVal = .T.
			lnRow = 0
			lnElement = ASCAN(raProperties, laWords[1])
			IF lnElement > 0
				lnRow = ASUBSCRIPT(raProperties, lnElement, 1)
			ENDIF
			
			IF lnRow > 0
				raProperties[lnRow,4] = laWords[3]
			ELSE
				lnRowCount = IIF(VARTYPE(raProperties[1,1]) # "C", 1, ALEN(raProperties,1) + 1)
				DIMENSION raProperties[lnRowCount, 5]
				raProperties[lnRowCount, 1] = laWords[1]
				raProperties[lnRowCount, 2] = .F.
				raProperties[lnRowCount, 3] = .F.
				raProperties[lnRowCount, 4] = laWords[3]
			ENDIF
		ENDFOR
		
		RETURN llRetVal	
	ENDPROC
	
		*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  FindMethodsInClass()
	*-------------------------------------------------------
	*) Description:  Finds all the procedures/functions
	*)	in the class pointed to by nClassStartElement and 
	*)	nClassEndElement
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE FindMethodsInClass(raMethods)
		LOCAL llRetVal, lnCount, lnWords, ;
			laWords[1], llProtected, llHidden, lcString, ;
			laProperties[1], llContinueLine, lnLoop, ;
			lnProperties, laMethods[1], lnMethods

		llRetVal  = .F.
		lnMethods = 0
		
		*-- Scan through each element looking for a procedure
		*-- of function
		FOR lnCount	= THIS.nClassStartElement TO THIS.nClassEndElement
			lnWords = THIS.WordsToArray(THIS.aClassFile[lnCount], @laWords)