Mini Kabibi Habibi
* RunCode.PRG - Run code block interpreter.
* Version 2.00
*
* Copyright (c) 1998-1999 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,__llVFP60
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
__llVFP60=" 06.0"$VERSION()
IF NOT __llVFP60
__lcLastOnError=ON("ERROR")
DO CASE
CASE __lcOnError=="__"
ON ERROR __RunCodeError(ERROR(),0,"RunCode","",MESSAGE())
CASE __lcOnError=="=.F."
ON ERROR =.F.
CASE EMPTY(__lcOnError)
ON ERROR
OTHERWISE
ON ERROR &__lcOnError
ENDCASE
__lvResult=.T.
IF __tlFile
__lcCode=""
__lcCode=ALLTRIM(FILETOSTR(__tcCode))
ELSE
__lcCode=IIF(VARTYPE(__tcCode)=="C",__tcCode,"")
ENDIF
IF LEFT(__lcCode,1)==";"
__lcCode=STRTRAN(__lcCode,";",CR_LF)
ENDIF
__lvResult=EVALUATE("ExecScript(__lcCode)")
IF EMPTY(__lcLastOnError)
ON ERROR
ELSE
ON ERROR &__lcLastOnError
ENDIF
RETURN __lvResult
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=""
__lcCode=ALLTRIM(FILETOSTR(__tcCode))
IF EMPTY(__lcCode)
RETURN
ENDIF
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=="ENDT"
__llTextMode=.F.
LOOP
CASE __llTextMode
__lcLine="\"+__lcLine
__lcLastLine=__lcLine
&__lcLine
LOOP
CASE __lcCommand=="DO_W"
IF __lnForStackCount<=0 AND __lnIfStackCount<=0
__lnDoStackCount=__lnDoStackCount+1
IF __lnDoStackCount<=1
__lcDoExpr=__lcExpr
__lnDoLine=__lnLine
LOOP
ENDIF
ENDIF
CASE __lcCommand=="FOR"
IF __lnDoStackCount<=0 AND __lnIfStackCount<=0
__lnForStackCount=__lnForStackCount+1
IF __lnForStackCount<=1
__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
ENDIF
CASE __lcCommand=="IF"
IF __lnDoStackCount<=0 AND __lnForStackCount<=0
__lnIfStackCount=__lnIfStackCount+1
IF __lnIfStackCount<=1
__lcIfExpr=__lcExpr
__llIfExpr=EVALUATE(__lcIfExpr)
__lnIfLine=__lnLine
LOOP
ENDIF
ENDIF
CASE __lcCommand=="ELSE"
IF __lnIfStackCount=1 AND __lnDoStackCount<=0 AND __lnForStackCount<=0
__llIfExpr=(NOT __llIfExpr)
LOOP
ENDIF
CASE __lcCommand=="ENDD"
IF __lnIfStackCount<=0 AND __lnForStackCount<=0
__lnDoStackCount=__lnDoStackCount-1
IF __lnDoStackCount<=0
DO WHILE NOT EMPTY(__lcDoExpr) AND EVALUATE(__lcDoExpr)
__lvResult=RunCode(@__laDoLines,.F.,__tvIgnoreErrors)
IF ISNULL(__laDoLines[1])
IF __llArrayCode
__tcCode[1]=.NULL.
ENDIF
IF EMPTY(__lcLastOnError)
ON ERROR
ELSE
ON ERROR &__lcLastOnError
ENDIF
RETURN __lvResult
ENDIF
IF NOT __lvResult
EXIT
ENDIF
ENDDO
__lcDoExpr=""
__llDoExpr=.F.
__lnDoLine=0
DIMENSION __laDoLines[1]
__laDoLines=.F.
__lnDoLineTotal=0
LOOP
ENDIF
ENDIF
CASE __lcCommand=="ENDF"
IF __lnIfStackCount<=0 AND __lnDoStackCount<=0
__lnForStackCount=__lnForStackCount-1
IF __lnForStackCount<=0
IF __lnForStep>0
DO WHILE EVALUATE(__lcForExpr)<=__lnForMax
__lvResult=RunCode(@__laForLines,.F.,__tvIgnoreErrors)
IF ISNULL(__laForLines[1])
IF __llArrayCode
__tcCode[1]=.NULL.
ENDIF
IF EMPTY(__lcLastOnError)
ON ERROR
ELSE
ON ERROR &__lcLastOnError
ENDIF
RETURN __lvResult
ENDIF
IF NOT __lvResult
EXIT
ENDIF
__lcExpr=__lcForExpr+"="+__lcForExpr+"+"+TRANSFORM(__lnForStep)
&__lcExpr
ENDDO
ELSE
DO WHILE EVALUATE(__lcForExpr)>=__lnForMax
__lvResult=RunCode(@__laForLines,.F.,__tvIgnoreErrors)
IF ISNULL(__laForLines[1])
IF __llArrayCode
__tcCode[1]=.NULL.
ENDIF
IF EMPTY(__lcLastOnError)
ON ERROR
ELSE
ON ERROR &__lcLastOnError
ENDIF
RETURN __lvResult
ENDIF
IF NOT __lvResult
EXIT
ENDIF
__lcExpr=__lcForExpr+"="+__lcForExpr+"+"+TRANSFORM(__lnForStep)
&__lcExpr
ENDDO
ENDIF
__lcForExpr=""
__lnForCount=0
__lnForMax=0
__lnForStep=0
__lnForLine=0
DIMENSION __laForLines[1]
__laForLines=.F.
__lnForLineTotal=0
LOOP
ENDIF
ENDIF
CASE __lcCommand=="ENDI"
IF __lnDoStackCount<=0 AND __lnForStackCount<=0
__lnIfStackCount=__lnIfStackCount-1
IF __lnIfStackCount<=0
__lvResult=RunCode(@__laIfLines,.F.,__tvIgnoreErrors)
IF ISNULL(__laIfLines[1])
IF __llArrayCode
__tcCode[1]=.NULL.
ENDIF
IF EMPTY(__lcLastOnError)
ON ERROR
ELSE
ON ERROR &__lcLastOnError
ENDIF
RETURN __lvResult
ENDIF
__lcIfExpr=""
__llIfExpr=.F.
__lnIfLine=0
DIMENSION __laIfLines[1]
__laIfLines=.F.
__lnIfLineTotal=0
LOOP
ENDIF
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=="EXIT"
IF __llArrayCode
__lvResult=.F.
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
IF _vfp.StartMode>0
RETURN
ENDIF
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)
IF INLIST(_VFP.StartMode,0,4)
WAIT CLEAR
WAIT WINDOW LEFT(lcMessage,254) NOWAIT
ENDIF
ENDFUNC
*-- end RunCode.PRG