runcode.prg

学生管理系统本系统由1个数据库、3个查询

* RunCode.PRG - Run code block interpreter.
*
* Copyright (c) 1998 Microsoft Corp.
* 1 Microsoft Way
* Redmond, WA 98052
*
* Description:
* Runs a block of VFP code via macros without compilation.
*
* Parameter list:
* cCode:	Code to execute or file name that contains code to execute
* lFile:	Specifies source file mode.
*				.F./Empty = Code is specified by cCode.
*				.T. = Code is imported from specified file via cCode value.
* lIgnoreErrors:	Specifies error handling mode.
*				.F./Empty = Errors are trapped and displayed in a wait window.
*				.T. = All errors are ignored.


LPARAMETERS __tcCode,__tlFile,__tvIgnoreErrors
LOCAL __lcCode,__lcOnError,__llArrayCode,__lcLine,__lnLine,__lcLine2
LOCAL __lcCommand,__lcExpr,__lcChar,__lnAtPos,__lnAtPos2,__lnOccurrence
LOCAL __lnLineTotal,__llTextMode,__lcLastOnError,__lvResult
LOCAL __lcDoExpr,__lnDoLine,__lnDoLineTotal,__lnDoStackCount
LOCAL __lcForExpr,__lnForMax,__lnForStep,__lnForLine,__lnForLineTotal,__lnForStackCount
LOCAL __lcIfExpr,__llIfExpr,__lnIfLine,__lnIfLineTotal,__lnIfStackCount
LOCAL __laLines[1],__laForLines[1],__laIfLines[1],__laDoLines[1]
EXTERNAL ARRAY __tcCode,__laLines,__laForLines,__laIfLines,__laDoLines

#DEFINE TAB		CHR(9)
#DEFINE LF		CHR(10)
#DEFINE CR		CHR(13)
#DEFINE CR_LF	CR+LF

IF VARTYPE(__tvIgnoreErrors)=="C"
	__lcOnError=ALLTRIM(__tvIgnoreErrors)
ELSE
	__lcOnError=IIF(__tvIgnoreErrors,"=.F.","__")
ENDIF
__llArrayCode=(TYPE("__tcCode[1]")=="C")
IF __llArrayCode
	__lnLineTotal=ACOPY(__tcCode,__laLines)
ELSE
	IF VARTYPE(__tcCode)#"C" OR EMPTY(__tcCode)
		RETURN
	ENDIF
	IF __tlFile
		__lcCode=ALLTRIM(FILETOSTR(__tcCode))
	ELSE
		__lcCode=ALLTRIM(__tcCode)
	ENDIF
	IF LEFT(__lcCode,1)==";"
		__lcCode=STRTRAN(__lcCode,";",CR_LF)
	ENDIF
	__lnLineTotal=ALINES(__laLines,__lcCode)
	IF __lnLineTotal=0
		RETURN
	ENDIF
	PRIVATE __lcLastLine
	__lcLastLine=""
	__lnLine=0
	DO WHILE __lnLine<__lnLineTotal
		__lnLine=__lnLine+1
		__lcLine=ALLTRIM(__laLines[__lnLine])
		__lnAtPos=AT("&"+"&",__lcLine)
		IF __lnAtPos>0
			__lcLine=ALLTRIM(LEFT(__lcLine,__lnAtPos-1))
		ENDIF
		DO WHILE .T.
			__lcChar=LEFT(__lcLine,1)
			IF __lcChar==" " OR __lcChar==TAB
				__lcLine=ALLTRIM(SUBSTR(__lcLine,2))
				LOOP
			ENDIF
			__lcChar=RIGHT(__lcLine,1)
			IF __lcChar==" " OR __lcChar==TAB
				__lcLine=TRIM(LEFT(__lcLine,LEN(__lcLine)-1))
				LOOP
			ENDIF
			EXIT
		ENDDO
		IF EMPTY(__lcLine) OR LEFT(__lcLine,1)=="*" OR LEFT(__lcLine,1)=="#" OR ;
				LEFT(__lcLine,2)==("&"+"&") OR UPPER(LEFT(__lcLine,4))=="NOTE" OR ;
				LEFT(__lcLine,4)=="<!--"
			ADEL(__laLines,__lnLine)
			__lnLineTotal=__lnLineTotal-1
			DIMENSION __laLines[__lnLineTotal]
			__lnLine=__lnLine-1
			LOOP
		ENDIF
		IF __lnLine>=2 AND RIGHT(__laLines[__lnLine-1],1)==";"
			__lcLine2=LEFT(__laLines[__lnLine-1],LEN(__laLines[__lnLine-1])-1)
			DO WHILE .T.
				__lcChar=RIGHT(__lcLine2,1)
				IF __lcChar==" " OR __lcChar==TAB
					__lcLine2=TRIM(LEFT(__lcLine2,LEN(__lcLine2)-1))
					LOOP
				ENDIF
				EXIT
			ENDDO
			__lnLine=__lnLine-1
			__lcLine=__lcLine2+" "+__lcLine
			ADEL(__laLines,__lnLine)
			__lnLineTotal=__lnLineTotal-1
			DIMENSION __laLines[__lnLineTotal]
			__laLines[__lnLine]=__lcLine
		ELSE
			__laLines[__lnLine]=__lcLine
		ENDIF
	ENDDO
ENDIF
IF __lnLineTotal=0
	RETURN
ENDIF
__lcLastOnError=ON("ERROR")
DO CASE
	CASE __lcOnError=="__"
		ON ERROR __RunCodeError(ERROR(),0,"RunCode",__lcLastLine,MESSAGE())
	CASE __lcOnError=="=.F."
		ON ERROR =.F.
	CASE EMPTY(__lcOnError)
		ON ERROR
	OTHERWISE
		ON ERROR &__lcOnError
ENDCASE
__lvResult=.T.
__lcLine=""
STORE .F. TO __llIfExpr,__llTextMode
STORE "" TO __lcDoExpr,__lcForExpr,__lcIfExpr
STORE 0 TO __lnLine,__lnDoLine,__lnDoLineTotal,__lnDoStackCount, ;
		__lnForLine,__lnForLineTotal,__lnForStackCount,__lnForMax, ;
		__lnForStep,__lnIfLine,__lnIfLineTotal,__lnIfStackCount
DO WHILE __lnLine<__lnLineTotal
	__lnLine=__lnLine+1
	__lcLine=__laLines[__lnLine]
	IF EMPTY(__lcLine)
		LOOP
	ENDIF
	IF LEFT(__lcLine,1)=="="
		EVALUATE(SUBSTR(__lcLine,2))
		LOOP
	ENDIF
	__lcCommand=UPPER(LEFT(__lcLine,4))
	IF __lcCommand=="DO W" AND (UPPER(LEFT(__lcLine,8))=="DO WHIL " OR ;
			UPPER(LEFT(__lcLine,8))=="DO WHILE")
		__lcCommand="DO_W"
		__lnOccurrence=2
	ELSE
		__lnOccurrence=1
	ENDIF
	__lnAtPos=AT(" ",__lcCommand,__lnOccurrence)
	__lnAtPos2=AT(TAB,__lcCommand,__lnOccurrence)
	IF BETWEEN(__lnAtPos2,1,__lnAtPos)
		__lnAtPos=__lnAtPos2
	ENDIF
	IF __lnAtPos>0
		__lcCommand=LEFT(__lcCommand,__lnAtPos-1)
	ENDIF
	__lnAtPos=AT(" ",__lcLine,__lnOccurrence)
	__lnAtPos2=AT(TAB,__lcLine,__lnOccurrence)
	IF BETWEEN(__lnAtPos2,1,__lnAtPos)
		__lnAtPos=__lnAtPos2
	ENDIF
	IF __lnAtPos=0
		__lcExpr=""
	ELSE
		__lcExpr=ALLTRIM(SUBSTR(__lcLine,__lnAtPos+1))
	ENDIF
	__lcLastLine=__lcLine
	DO CASE
		CASE __lcCommand=="EXIT"
			IF __llArrayCode
				RETURN .F.
			ENDIF
			LOOP
		CASE __lcCommand=="ENDT"
			__llTextMode=.F.
			LOOP
		CASE __llTextMode
			__lcLine="\"+__lcLine
			__lcLastLine=__lcLine
			&__lcLine
			LOOP
		CASE __lcCommand=="DO_W"
			__lnDoStackCount=__lnDoStackCount+1
			IF __lnDoStackCount=1 AND __lnForStackCount=0 AND __lnIfStackCount=0
				__lcDoExpr=__lcExpr
				__lnDoLine=__lnLine
				LOOP
			ENDIF
		CASE __lcCommand=="FOR"
			__lnForStackCount=__lnForStackCount+1
			IF __lnDoStackCount=0 AND __lnDoStackCount=0 AND __lnIfStackCount=0
				__lnAtPos=ATC(" TO ",__lcExpr)
				IF __lnAtPos=0
					__lcForExpr=""
					__lnForMax=0
					__lnForStep=0
					LOOP
				ENDIF
				__lcForExpr=__lcExpr
				__lcForExpr=ALLTRIM(LEFT(__lcExpr,__lnAtPos-1))
				__lcExpr=ALLTRIM(SUBSTR(__lcExpr,__lnAtPos+4))
				__lnAtPos=ATC("=",__lcForExpr)
				IF __lnAtPos=0
					LOOP
				ENDIF
				&__lcForExpr
				__lcForExpr=ALLTRIM(LEFT(__lcForExpr,__lnAtPos-1))
				__lnAtPos=ATC(" STEP ",__lcExpr)
				IF __lnAtPos=0
					__lnForMax=EVALUATE(__lcExpr)
					__lnForStep=1
				ELSE
					__lnForMax=EVALUATE(LEFT(__lcExpr,__lnAtPos-1))
					__lnForStep=EVALUATE(SUBSTR(__lcExpr,__lnAtPos+6))
				ENDIF
				__lnForLine=__lnLine
				LOOP
			ENDIF
		CASE __lcCommand=="IF"
			__lnIfStackCount=__lnIfStackCount+1
			IF __lnIfStackCount=1 AND __lnDoStackCount=0 AND __lnForStackCount=0
				__lcIfExpr=__lcExpr
				__llIfExpr=EVALUATE(__lcIfExpr)
				__lnIfLine=__lnLine
				LOOP
			ENDIF
		CASE __lcCommand=="ELSE"
			IF __lnIfStackCount=1 AND __lnDoStackCount=0 AND __lnForStackCount=0
				__llIfExpr=(NOT __llIfExpr)
				LOOP
			ENDIF
		CASE __lcCommand=="ENDD"
			__lnDoStackCount=__lnDoStackCount-1
			IF __lnDoStackCount=0 AND __lnForStackCount=0 AND __lnIfStackCount=0
				DO WHILE NOT EMPTY(__lcDoExpr) AND EVALUATE(__lcDoExpr)
					__lvResult=RunCode(@__laDoLines,.F.,__tvIgnoreErrors)
					IF ISNULL(__laDoLines[1])
						IF __llArrayCode
							__tcCode[1]=.NULL.
						ENDIF
						RETURN __lvResult
					ENDIF
					IF NOT __lvResult
						EXIT
					ENDIF
				ENDDO
				__lcDoExpr=""
				__llDoExpr=.F.
				__lnDoLine=0
				DIMENSION __laDoLines[1]
				__laDoLines=.F.
				__lnDoLineTotal=0
				LOOP
			ENDIF
		CASE __lcCommand=="ENDF"
			__lnForStackCount=__lnForStackCount-1
			IF __lnDoStackCount=0 AND __lnForStackCount=0 AND __lnIfStackCount=0
				DO WHILE EVALUATE(__lcForExpr)<=__lnForMax
					__lvResult=RunCode(@__laForLines,.F.,__tvIgnoreErrors)
					IF ISNULL(__laForLines[1])
						IF __llArrayCode
							__tcCode[1]=.NULL.
						ENDIF
						RETURN __lvResult
					ENDIF
					IF NOT __lvResult
						EXIT
					ENDIF
					__lcExpr=__lcForExpr+"="+__lcForExpr+"+"+TRANSFORM(__lnForStep)
					&__lcExpr
				ENDDO
				__lcForExpr=""
				__lnForCount=0
				__lnForMax=0
				__lnForStep=0
				__lnForLine=0
				DIMENSION __laForLines[1]
				__laForLines=.F.
				__lnForLineTotal=0
				LOOP
			ENDIF
		CASE __lcCommand=="ENDI"
			__lnIfStackCount=__lnIfStackCount-1
			IF __lnIfStackCount=0 AND __lnDoStackCount=0 AND __lnForStackCount=0
				__lvResult=RunCode(@__laIfLines,.F.,__tvIgnoreErrors)
				IF ISNULL(__laIfLines[1])
					IF __llArrayCode
						__tcCode[1]=.NULL.
					ENDIF
					RETURN __lvResult
				ENDIF
				__lcIfExpr=""
				__llIfExpr=.F.
				__lnIfLine=0
				DIMENSION __laIfLines[1]
				__laIfLines=.F.
				__lnIfLineTotal=0
				LOOP
			ENDIF
	ENDCASE
	IF __lnDoStackCount>0
		__lnDoLineTotal=__lnDoLineTotal+1
		DIMENSION __laDoLines[__lnDoLineTotal]
		__laDoLines[__lnDoLineTotal]=__lcLine
		LOOP
	ENDIF
	IF __lnForStackCount>0 AND __lnDoStackCount=0
		__lnForLineTotal=__lnForLineTotal+1
		DIMENSION __laForLines[__lnForLineTotal]
		__laForLines[__lnForLineTotal]=__lcLine
		LOOP
	ENDIF
	IF __lnIfStackCount>0
		IF NOT __llIfExpr
			LOOP
		ENDIF
		__lnIfLineTotal=__lnIfLineTotal+1
		DIMENSION __laIfLines[__lnIfLineTotal]
		__laIfLines[__lnIfLineTotal]=__lcLine
		LOOP
	ENDIF
	DO CASE
		CASE __lcCommand=="RETU"
			IF __llArrayCode
				__tcCode[1]=.NULL.
			ENDIF
			IF NOT EMPTY(__lcExpr)
				__lvResult=EVALUATE(__lcExpr)
			ENDIF
			EXIT
		CASE __lcCommand=="TEXT"
			__llTextMode=.T.
			LOOP
		CASE __lcCommand=="ENDT"
			__llTextMode=.F.
			LOOP
	ENDCASE
	&__lcLine
ENDDO
IF EMPTY(__lcLastOnError)
	ON ERROR
ELSE
	ON ERROR &__lcLastOnError
ENDIF
RETURN __lvResult



FUNCTION __RunCodeError(tnError,tnLine,tcMethod,tcLine,tcMessage)
LOCAL lcMessage

lcMessage="RunCode Runtime Error"+CR_LF+ ;
		REPLICATE("-",40)+CR_LF+ ;
		"Error:      "+TRANSFORM(tnError)+CR_LF+ ;
		TRANSFORM(tcMessage)+CR_LF+ ;
		REPLICATE("-",40)+CR_LF+ ;
		"Method:  "+TRANSFORM(tcMethod)+CR_LF+ ;
		"Line        "+TRANSFORM(tnLine)+CR_LF+ ;
		REPLICATE("-",40)+CR_LF+ ;
		TRANSFORM(tcLine)
WAIT CLEAR
WAIT WINDOW LEFT(lcMessage,254) NOWAIT
ENDFUNC


*-- end RunCode.PRG