cclassparser.prg

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

*************************************************
DEFINE CLASS CProgrammaticClassParser AS SESSION OLEPUBLIC
*************************************************
	PROTECTED nClassStartElement, nClassEndElement, ;
		nLastClassCharCount, aClassFile[1], Version, ;
		cErrorString
	
	Version               = "1.1"
	nClassStartElement    = 1
	nClassEndElement      = 1
	nLastClassCharCount   = 1
	cErrorString          = ""
	DIMENSION aClassFile[1]

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  Init()
	*-------------------------------------------------------
	*) Description: 
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE Init()
		SET DELETED ON
		THIS.CreateClassCursors()
	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  CreateClassCursors()
	*-------------------------------------------------------
	*) Description:  Builds the required cursors 
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE CreateClassCursors()
		
		IF !USED('cn_classes')
			CREATE CURSOR "cn_classes" (id C(10), filenameex C(240), classname c(240), ;
				parent c(240), olepublic L, startchar N(8))
		
			INDEX ON id         					TAG id OF cn_classes
			INDEX ON filenameex 					TAG filenameex OF cn_classes
			INDEX ON ALLTRIM(UPPER(classname))  	TAG classname OF cn_classes
			INDEX ON ALLTRIM(UPPER(parent))     	TAG parent OF cn_classes
		ENDIF

		IF !USED('cn_properties')
			CREATE CURSOR "cn_properties" (id C(10), classid C(10), propname C(240), value M, ;
				Protected L, Hidden L, startchar N(8))

			INDEX ON classid  TAG classid OF cn_properties
			INDEX ON propname TAG propname OF cn_properties
		ENDIF

		IF !USED('cn_methods')
			CREATE CURSOR "cn_methods" (id C(10), classid C(10), methname C(240), parameters M, ;
				Protected L, Hidden L, startchar N(8))

			INDEX ON id 		TAG id 			OF cn_methods
			INDEX ON classid 	TAG classid 	OF cn_methods
			INDEX ON methname 	TAG methname 	OF cn_methods
		ENDIF
		
	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  BuildClassesFromFile()
	*-------------------------------------------------------
	*) Description:  Accepts a filename. Stores the file
	*)	in an array and iterates through it pulling out all 
	*)	class information, properties, methods, etc.
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE BuildClassesFromFile(tcFullFilename)
		LOCAL llRetVal, lcString, lnStartChar, laClass[1], ;
			laProperties[1], laMethods[1], lnKey 
		
		llRetVal = THIS.StoreFileInFileArray(tcFullFilename)
		IF llRetVal
			DO WHILE THIS.FindNextClassInFileArray(@laClass)
				lcKey = THIS.AddClass(tcFullFilename, @laClass)
					IF THIS.FindPropertiesInClass(@laProperties)
						THIS.AddProperties(lcKey, @laProperties)
					ENDIF

					IF THIS.FindMethodsInClass(@laMethods)
						THIS.AddMethods(lcKey, @laMethods)
					ENDIF
			ENDDO
		ENDIF		
		
		RETURN llRetVal
	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  DestroyClassesFromFile()
	*-------------------------------------------------------
	*) Description:  Removes all class information that
	*)	was found in tcFullFilename
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROCEDURE DestroyClassesFromFile(tcFullFilename)
		LOCAL llRetVal, lcFullFilename, lcClassID
		
		lcFullFilename = ALLTRIM(tcFullFilename)

		DO WHILE SEEK(lcFullFilename, "cn_classes", "filenameex")
			lcClassID = cn_classes.id
			
			SELECT cn_classes
			DELETE ALL FOR cn_classes.id = lcClassID
			
			SELECT cn_properties
			DELETE ALL FOR cn_properties.classid = lcClassID
			
			SELECT cn_methods
			DELETE ALL FOR cn_methods.classid = lcClassID
		ENDDO

	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  StoreFileInFileArray()
	*-------------------------------------------------------
	*) Description:  Stores the contents of a file in
	*)	the aClassFile array. Each line in the file will
	*)	be stored in a separate row of the array.
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE StoreFileInFileArray(tcFullFilename)
		LOCAL llRetVal, lcFileContents, lcOldError
		
		llRetVal = IIF(FILE(tcFullFilename), .T., .F.)
		IF llRetVal
			
			*-- If the file is already open or otherwise
			*-- unavailable, capture the error here
			*-- and add the error string to the
			*-- cErrorString property
			lcOldError = ON("ERROR")
			ON ERROR llRetVal = .F.
			lcFileContents = FILETOSTR(tcFullFilename)
			IF !llRetVal
				THIS.cErrorString = MESSAGE() + CHR(13) + ALLTRIM(tcFullFileName)
			ELSE
				lcFileContents = STRTRAN(lcFileContents, CHR(9), " ")
				= ALINES(this.aClassFile, lcFileContents)

				THIS.nClassStartElement = 1
				THIS.nClassEndElement   = 1
			ENDIF
			ON ERROR &lcOldError
		ENDIF
		
		RETURN llRetVal
		
	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  AddClass()
	*-------------------------------------------------------
	*) Description:  Adds a class to the class cursor
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Character
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE AddClass(tcFullFilename, raClass)
		LOCAL lcRetVal, lcFileContents
		
		lcRetVal = ""
		lcRetVal = SYS(2015)
		INSERT INTO "cn_classes" (id, filenameex, classname, parent, olepublic, startchar) ;
			VALUES (lcRetVal, tcFullFilename, raClass[1], raClass[2], raClass[3], raClass[4])
		
		RETURN lcRetVal

	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  AddProperties()
	*-------------------------------------------------------
	*) Description:  Adds properties to the properties cursor
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Character
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE AddProperties(tcClassKey, raProperties)
		LOCAL lcFileContents, lnLoop, lcID
		
		FOR lnLoop = 1 to ALEN(raProperties,1)
	
			lcID = SYS(2015)

			INSERT INTO "cn_properties" (id, classid, propname, protected, hidden, value) ;
			VALUES (lcID, tcClassKey, raProperties[lnLoop,1], raProperties[lnLoop,2], raProperties[lnLoop,3], raProperties[lnLoop,4])

		ENDFOR

		RETURN 

	ENDPROC
	*///////////////////////////////////////////////////////	

	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  AddMethods()
	*-------------------------------------------------------
	*) Description:  Adds methods to the methods cursor
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE AddMethods(tcClassKey, raMethods)
		LOCAL lcFileContents, lnLoop, lcID
		
		FOR lnLoop = 1 to ALEN(raMethods,1)

			lcID = SYS(2015)

			INSERT INTO "cn_methods" (id, classid, methname, protected, hidden, parameters, startchar) ;
			VALUES (lcID, tcClassKey, raMethods[lnLoop,1], raMethods[lnLoop,2], raMethods[lnLoop,3], raMethods[lnLoop,4], raMethods[lnLoop,5])

		ENDFOR
		RETURN 

	ENDPROC
	*///////////////////////////////////////////////////////	


	*---------------- Location Section ---------------------
	*} Library: CCLASSPARSER.PRG
	*} Class:   CProgrammaticClassParser
	*} Method:  FindNextClassInFileArray()
	*-------------------------------------------------------
	*) Description:  Finds the next class in the aClassFile
	*	array
	*------------------- Usage Section ---------------------
	*$ Scope:		
	*$ Parameters:  
	*$ Usage:		
	*$ Returns:		Logical
	*$ Notes:		
	*-------------------------------------------------------
	*!	Copyright:
	*!		Flash Creative Management, Inc., 1999
	*!		Author: Michael G. Emmons
	*!		Architect: Michael G. Emmons
	*-------------------------------------------------------
	PROTECTED PROCEDURE FindNextClassInFileArray(raClass)
		LOCAL llRetVal, lcSearchFor, lcSearchFor2, ;
			lnCount, lnWords, laClassDef[1]