* VFPScrpt.prg
*
*-- ASCII codes
#DEFINE	EOB		CHR(0)
#DEFINE	MARKER	CHR(1)
#DEFINE	TAB		CHR(9)
#DEFINE	LF		CHR(10)
#DEFINE	CR		CHR(13)
#DEFINE CR_LF	CR+LF

*-- Strings
#DEFINE	VFPS_SCRIPT_START	'<SCRIPT LANGUAGE="VFPScript">'
#DEFINE	VFPS_SCRIPT_START2	'<SCRIPT LANGUAGE="VFPS">'
#DEFINE	VBS_SCRIPT_START	'<SCRIPT LANGUAGE="VBScript">'
#DEFINE SCRIPT_END			"</SCRIPT>"
#DEFINE	VFPS_FUNCTION_START	"FUNC"
#DEFINE	VFPS_FUNCTION_END	"ENDF"
#DEFINE	VBS_FUNCTION_START	"Sub"
#DEFINE	VBS_FUNCTION_END	"End Sub"



LPARAMETERS toWebBrowser

RETURN HTMLX(toWebBrowser)



FUNCTION HTMLX(toWebBrowser)
PRIVATE pcSourceText,pcNewSourceText,pcAppendSourceText
LOCAL lcVFPScript,lcFilePath,lcFileName,lnLastSelect
LOCAL lcMainScriptCode,lcScriptCode,lcScript
LOCAL lcMemLine,lnCount,lnAtPos,lnAtPos1,lnAtPos2

IF TYPE("toWebBrowser")#"O" OR ISNULL(toWebBrowser)
	RETURN .F.
ENDIF
toWebBrowser.nScriptCount=0
DIMENSION toWebBrowser.aScripts[1,2]
toWebBrowser.aScripts=""
lnLastSelect=SELECT()
CREATE CURSOR tempHTMLfile (Source M)
APPEND BLANK
APPEND MEMO Source FROM (toWebBrowser.cSourceFileName) OVERWRITE
pcSourceText=ALLTRIM(Source)
USE
IF NOT LEFT(pcSourceText,1)=="CR"
	pcSourceText=CR+pcSourceText
ENDIF
IF NOT RIGHT(pcSourceText,1)=="CR"
	pcSourceText=pcSourceText+CR
ENDIF
pcNewSourceText=StrTranC(pcSourceText,VFPS_SCRIPT_START2,VFPS_SCRIPT_START)
pcAppendSourceText=""
DO WHILE .T.
	IF toWebBrowser.lRelease
		EXIT
	ENDIF
	lcVFPScript=""
	lnAtPos1=ATC(VFPS_SCRIPT_START,pcNewSourceText)
	IF lnAtPos1=0
		pcNewSourceText=EvlTxt(pcNewSourceText)
		IF NOT EMPTY(pcAppendSourceText)
			IF toWebBrowser.lDebug
				ViewString(toWebBrowser,pcAppendSourceText)
			ENDIF
			pcNewSourceText=pcNewSourceText+pcAppendSourceText
			pcAppendSourceText=""
			LOOP
		ENDIF
		EXIT
	ENDIF
	lnAtPos2=ATC(SCRIPT_END,SUBSTR(pcNewSourceText,lnAtPos1))
	IF lnAtPos2=0
		EXIT
	ENDIF
	lcVFPScript=EvlTxt(SUBSTR(pcNewSourceText,lnAtPos1+LEN(VFPS_SCRIPT_START), ;
			lnAtPos2-LEN(VFPS_SCRIPT_START)-1))
	IF NOT EMPTY(pcAppendSourceText)
		IF toWebBrowser.lDebug
			ViewString(toWebBrowser,pcAppendSourceText)
		ENDIF
		lcVFPScript=lcVFPScript+pcAppendSourceText
		pcAppendSourceText=""
	ENDIF
	lcVFPScript=ALLTRIM(STRTRAN(STRTRAN(STRTRAN(lcVFPScript,CR_LF,CR),LF,""),TAB," "))
	pcNewSourceText=LEFT(pcNewSourceText,lnAtPos1-1)+ ;
			SUBSTR(pcNewSourceText,lnAtPos1+lnAtPos2+LEN(SCRIPT_END))
	DO WHILE LEFT(lcVFPScript,1)==CR
		lcVFPScript=ALLTRIM(SUBSTR(lcVFPScript,2))
	ENDDO
	DO WHILE RIGHT(lcVFPScript,1)==CR
		lcVFPScript=ALLTRIM(LEFT(lcVFPScript,LEN(lcVFPScript)-1))
	ENDDO
	IF EMPTY(lcVFPScript)
		LOOP
	ENDIF
	lcMainScriptCode=""
	lcScriptCode=""
	lcScript=""
	_mline=0
	FOR lnCount = 1 TO MEMLINES(lcVFPScript)
		lcMemLine=ALLTRIM(MLINE(lcVFPScript,1,_mline))
		IF EMPTY(lcMemLine) OR LEFT(lcMemLine,1)="*" OR LEFT(lcMemLine,2)=("&" +"&") OR ;
				LEFT(lcMemLine,1)="#" OR LEFT(lcMemLine,4)="<!--" OR LEFT(lcMemLine,3)="-->"
			LOOP
		ENDIF
		IF UPPER(LEFT(lcMemLine,4))==VFPS_FUNCTION_START
			IF EMPTY(lcMainScriptCode)
				lcMainScriptCode=lcScriptCode
			ENDIF
			lcScriptCode=""
			lnAtPos=AT(" ",lcMemLine)
			lcScript=LOWER(IIF(lnAtPos=0,SYS(3),ALLTRIM(SUBSTR(lcMemLine,lnAtPos+1))))
			LOOP
		ENDIF
		IF UPPER(LEFT(lcMemLine,4))==VFPS_FUNCTION_END
			WITH toWebBrowser
				.nScriptCount=.nScriptCount+1
				DIMENSION .aScripts[.nScriptCount,2]
				.aScripts[.nScriptCount,1]=lcScript
				.aScripts[.nScriptCount,2]=lcScriptCode
			ENDWITH
			lcScript=""
			lcScriptCode=""
			LOOP
		ENDIF
		lcScriptCode=lcScriptCode+lcMemLine+CR
	ENDFOR
	IF EMPTY(lcMainScriptCode) AND EMPTY(lcScript)
		lcMainScriptCode=lcScriptCode
	ENDIF
	IF NOT EMPTY(lcMainScriptCode)
		toWebBrowser.RunCode(lcMainScriptCode)
	ENDIF
	lcVFPScript=""
ENDDO
pcNewSourceText=EvlTxt(pcNewSourceText)
IF NOT EMPTY(pcAppendSourceText)
	IF toWebBrowser.lDebug
		ViewString(toWebBrowser,pcAppendSourceText)
	ENDIF
	pcNewSourceText=pcNewSourceText+pcAppendSourceText
	pcAppendSourceText=""
ENDIF
IF toWebBrowser.lRelease OR pcNewSourceText==pcSourceText
	SELECT (lnLastSelect)
	RETURN .F.
ENDIF
CREATE CURSOR ("_Temp"+SYS(3)) (Text M)
INSERT BLANK
REPLACE Text WITH pcNewSourceText
IF NOT toWebBrowser.lRefreshMode
	toWebBrowser.EraseTempFile
	lcFilePath=LOWER(toWebBrowser.TrimFile(toWebBrowser.cSourceFileName))
	lnAtPos1=RAT(":",lcFilePath)
	IF lnAtPos1>2
		lcFilePath=ALLTRIM(SUBSTR(lcFilePath,lnAtPos1-1))
	ENDIF
	lcFileName=lcFilePath+"_temp"+SYS(3)+".htm"
	toWebBrowser.cTempFileName=lcFileName
ENDIF
COPY MEMO Text TO (toWebBrowser.cTempFileName)
USE
SELECT (lnLastSelect)
RETURN



FUNCTION ViewString(toWebBrowser,tcString)
LOCAL lcTempFileName

lcTempFileName=SYS(2023)+"\"+SYS(3)+".prg"
IF EMPTY(tcString) OR NOT toWebBrowser.StringToFile(tcString,lcTempFileName)
	RETURN .F.
ENDIF
MODIFY COMM (lcTempFileName) NOMODIFY
ERASE (lcTempFileName)
ENDFUNC



FUNCTION strtranc(expc1,expc2,expc3,expn1,expn2)
LOCAL expr,at_pos,at_pos2,i,j

IF EMPTY(m.expc1).OR.EMPTY(m.expc2)
  RETURN m.expc1
ENDIF
m.expr=m.expc1
IF TYPE("m.expn1")#"N"
  m.expn1=1
ENDIF
IF TYPE("m.expn2")#"N"
  m.expn2=LEN(m.expc1)
ENDIF
IF m.expn1<1.OR.m.expn2<1
  RETURN m.expc1
ENDIF
m.i=0
m.j=0
m.at_pos2=1
DO WHILE .T.
  m.at_pos=ATC(m.expc2,SUBSTR(m.expr,m.at_pos2))
  IF m.at_pos=0
    EXIT
  ENDIF
  m.i=m.i+1
  IF m.i<m.expn1
    m.at_pos2=m.at_pos+m.at_pos2+LEN(m.expc2)-1
    LOOP
  ENDIF
  m.expr=LEFT(m.expr,m.at_pos+m.at_pos2-2)+m.expc3+;
         SUBSTR(m.expr,m.at_pos+m.at_pos2+LEN(m.expc2)-1)
  m.j=m.j+1
  IF m.j>=m.expn2
    EXIT
  ENDIF
  m.at_pos2=m.at_pos+m.at_pos2+LEN(m.expc3)-1
  IF m.at_pos2>LEN(m.expr)
    EXIT
  ENDIF
ENDDO
RETURN m.expr

* END strtranc



FUNCTION evltxt(old_text)
LOCAL new_text,eval_str,eval_str1,eval_str2,var_type
LOCAL at_pos,at_pos2,at_pos3,at_pos4,at_pos5,old_str,new_str
LOCAL i,j,at_line,evlmode,mthd_str,sellast
LOCAL lcFunction,lcType,lcControl,lcDataSource,lcDataSource2,lcSize,lcEvent
LOCAL lcCommand,lcAlias,lnAtPos

IF oTHIS.lRelease
	RETURN ""
ENDIF
m.new_text=m.old_text
lcControl=""
m.at_pos3=1
DO WHILE .T.
  m.at_pos=AT("{{",SUBSTR(m.old_text,m.at_pos3))
  IF m.at_pos=0
    EXIT
  ENDIF
  m.at_pos2=AT("}}",SUBSTR(m.old_text,m.at_pos+m.at_pos3-1))
  IF m.at_pos2=0
    EXIT
  ENDIF
  m.at_pos4=AT("{{",SUBSTR(m.old_text,m.at_pos+m.at_pos3+1))
  IF m.at_pos4>0.AND.m.at_pos4<m.at_pos2
    m.at_pos4=OCCURS("{{",SUBSTR(m.old_text,m.at_pos+m.at_pos3-1,;
              m.at_pos2-m.at_pos4))
    m.at_pos4=AT("{{",SUBSTR(m.old_text,m.at_pos+m.at_pos3-1),m.at_pos4)
    m.old_str=SUBSTR(m.old_text,m.at_pos+m.at_pos3-1,m.at_pos2+1)
    m.eval_str=SUBSTR(m.old_str,3,LEN(m.old_str)-2)
    m.old_str=evltxt(m.eval_str)
    m.old_text=STRTRAN(m.old_text,m.eval_str,m.old_str)
    m.new_text=STRTRAN(m.new_text,m.eval_str,m.old_str)
    LOOP
  ENDIF
  m.old_str=SUBSTR(m.old_text,m.at_pos+m.at_pos3-1,m.at_pos2+1)
  m.eval_str=ALLTRIM(SUBSTR(m.old_str,3,LEN(m.old_str)-4))
  m.evlmode=.F.
  DO CASE
    CASE EMPTY(m.eval_str)
      m.eval_str=""
    CASE LEFT(m.eval_str,2)=="&."
      m.eval_str=SUBSTR(m.eval_str,3)
      &eval_str &&;
      Error occured during macro substitution of {{&. <expC> }}.
      m.eval_str=""
    CASE LEFT(m.eval_str,1)=="<"
      m.eval_str=insert(SUBSTR(m.eval_str,2)) &&;
      Error occured during evaluation of {{< <file> }}.
    CASE LEFT(m.eval_str,1)==">"
      m.eval_str=SUBSTR(m.eval_str,2)
      oTHIS.RunScript(m.eval_str) &&;
      Error occured during RunScript of {{> <expC> }}.
      m.eval_str=IIF(TYPE("oTHIS.uValue")=="C",oTHIS.uValue,"")
    CASE LEFT(m.eval_str,1)=="@"
      m.eval_str=SUBSTR(m.eval_str,2)
      lnAtPos=AT(",",m.eval_str)
      IF lnAtPos=0
      	RETURN .F.
      ENDIF
      lcControl=ALLTRIM(SUBSTR(m.eval_str,lnAtPos+1))
      lcType=ALLTRIM(LEFT(m.eval_str,lnAtPos-1))
      lcDataSource=""
      lcSize=""
      lcEvent=""
      lnAtPos=AT(",",lcControl)
      IF lnAtPos>0
        lcDataSource=ALLTRIM(SUBSTR(lcControl,lnAtPos+1))
        lcControl=ALLTRIM(LEFT(lcControl,lnAtPos-1))
        lnAtPos=AT(",",lcDataSource)
        IF lnAtPos>0
          lcSize=ALLTRIM(SUBSTR(lcDataSource,lnAtPos+1))
          lcDataSource=ALLTRIM(LEFT(lcDataSource,lnAtPos-1))
          lnAtPos=AT(",",lcSize)
          IF lnAtPos>0
            lcEvent=ALLTRIM(SUBSTR(lcSize,lnAtPos+1))
            lcSize=ALLTRIM(LEFT(lcSize,lnAtPos-1))
           ENDIF
        ENDIF
      ENDIF
      IF EMPTY(lcType)
      	lcType="TEXT"
      ENDIF
      IF EMPTY(lcControl) OR EMPTY(lcDataSource)
      	RETURN ""
      ENDIF
      m.eval_str=lcDataSource
      m.eval_str=EVALUATE(m.eval_str) &&;
      Error occured during evaluation of {{ <expC> }}.
      lcCommand=[INPUT TYPE="]+lcType+[" NAME="]+lcControl+[" ]
      m.var_type=TYPE("m.eval_str")
      IF EMPTY(lcEvent)
        lcEvent=IIF(m.var_type=="L","OnClick","OnChange")
      ENDIF
      lcFunction=lcControl+"_"+lcEvent
      pcAppendSourceText=pcAppendSourceText+CR+VBS_SCRIPT_START+CR+ ;
        VBS_FUNCTION_START+" "+lcFunction+CR
      DO CASE
        CASE m.var_type=="C" OR m.var_type=="M"
          m.var_type=ALLTRIM(m.var_type)
          pcAppendSourceText=pcAppendSourceText+[Navigate "vfps://RunScript?]+ ;
            lcFunction+[," + ]+lcControl+[.Value]+CR
          IF EMPTY(lcSize)
            lcSize=ALLTRIM(STR(LEN(m.eval_str)))
          ENDIF
        CASE m.var_type=="L"
          pcAppendSourceText=pcAppendSourceText+[Dim Result]+CR+ ;
            [If ]+lcControl+[.Checked Then]+CR+ ;
            [  Result = "(.T.)"]+CR+ ;
            [Else]+CR+ ;
            [  Result = "(.F.)"]+CR+ ;
            [End If]+CR+ ;
            [Navigate "vfps://RunScript?]+lcFunction+[," + Result]+CR
        CASE m.var_type=="N"
          pcAppendSourceText=pcAppendSourceText+[Navigate "vfps://RunScript?]+ ;
            lcFunction+[,0" + ]+lcControl+[.Value]+CR
          IF EMPTY(lcSize)
            lcSize=ALLTRIM(STR(LEN(ALLTRIM(STR(m.eval_str)))))
          ENDIF
        CASE m.var_type=="D"
          pcAppendSourceText=pcAppendSourceText+[Navigate "vfps://RunScript?]+ ;
            lcFunction+[," + ]+lcControl+[.Value]+CR
          IF EMPTY(lcSize)
            lcSize=ALLTRIM(STR(LEN(DTOC(m.eval_str))))
          ENDIF
        CASE m.var_type=="T"
          pcAppendSourceText=pcAppendSourceText+[Navigate "vfps://RunScript?]+ ;
            lcFunction+[," + ]+lcControl+[.Value]+CR
          IF EMPTY(lcSize)
            lcSize=ALLTRIM(STR(LEN(TTOC(m.eval_str))))
          ENDIF
        OTHERWISE
          pcAppendSourceText=pcAppendSourceText+[Navigate "vfps://RunScript?]+ ;
            lcFunction+[," + ]+lcControl+[.Value]+CR
      ENDCASE
      pcAppendSourceText=pcAppendSourceText+VBS_FUNCTION_END+CR+ ;
        SCRIPT_END+CR+CR+VFPS_SCRIPT_START+CR+ ;
        VFPS_FUNCTION_START+" "+lcFunction+CR
      DO CASE
        CASE m.var_type=="C" OR m.var_type=="L"
          lcDataSource2="oTHIS.aParameters[2]"
        CASE m.var_type=="N"
          lcDataSource2="VAL(oTHIS.aParameters[2])"
        CASE m.var_type=="D"
          lcDataSource2="CTOD(oTHIS.aParameters[2])"
        CASE m.var_type=="T"
          lcDataSource2="CTOT(oTHIS.aParameters[2])"
        OTHERWISE
          lcDataSource2="oTHIS.aParameters[2]"
      ENDCASE
      lnAtPos=AT(".",lcDataSource)
      lcAlias=IIF(lnAtPos=0,"",ALLTRIM(LEFT(lcDataSource,lnAtPos-1)))
      IF USED(lcAlias)
        pcAppendSourceText=pcAppendSourceText+ ;
          [pnLastSelectTmp0=SELECT()]+CR+ ;
          [SELECT ]+lcAlias+CR+ ;
          [REPLACE ]+lcDataSource+[ WITH ]+lcDataSource2+CR+ ;
          [SELECT (pnLastSelectTmp0)]+CR
      ELSE
        pcAppendSourceText=pcAppendSourceText+lcDataSource+[=]+lcDataSource2+CR
      ENDIF
      pcAppendSourceText=pcAppendSourceText+VFPS_FUNCTION_END+CR+ ;
      	SCRIPT_END+CR
      DO CASE
        CASE m.var_type=="C"
          m.eval_str=[VALUE="]+m.eval_str+["]
        CASE m.var_type=="N"
          m.eval_str=ALLTRIM(STR(m.eval_str,24,12))
          DO WHILE RIGHT(m.eval_str,1)=="0"
            m.eval_str=LEFT(m.eval_str,LEN(m.eval_str)-1)
            IF RIGHT(m.eval_str,1)=="."
               m.eval_str=LEFT(m.eval_str,LEN(m.eval_str)-1)
              EXIT
            ENDIF
          ENDDO
          m.eval_str=[VALUE=]+m.eval_str
        CASE m.var_type=="D"
          m.eval_str=[VALUE="]+DTOC(m.eval_str)+["]
        CASE m.var_type=="T"
          m.eval_str=[VALUE="]+TTOC(m.eval_str)+["]
        CASE m.var_type=="L"
          m.eval_str=IIF(m.eval_str,"CHECKED","")
        OTHERWISE
          m.eval_str=""
      ENDCASE
      IF NOT EMPTY(lcSize)
        m.eval_str=m.eval_str+[ SIZE=]+lcSize
      ENDIF
      m.eval_str=lcCommand+m.eval_str
    OTHERWISE
      m.eval_str=EVALUATE(m.eval_str) &&;
      Error occured during evaluation of {{ <expC> }}.
  ENDCASE
  m.var_type=TYPE("m.eval_str")
  DO CASE
    CASE m.var_type=="C"
      m.new_str=m.eval_str
    CASE m.var_type=="N"
      m.new_str=ALLTRIM(STR(m.eval_str,24,12))
      DO WHILE RIGHT(m.new_str,1)=="0"
        m.new_str=LEFT(m.new_str,LEN(m.new_str)-1)
        IF RIGHT(m.new_str,1)=="."
          m.new_str=LEFT(m.new_str,LEN(m.new_str)-1)
          EXIT
        ENDIF
      ENDDO
    CASE m.var_type=="D"
      m.new_str=DTOC(m.eval_str)
    CASE m.var_type=="T"
      m.new_str=TTOC(m.eval_str)
    CASE m.var_type=="L"
      m.new_str=IIF(m.eval_str,".T.",".F.")
    OTHERWISE
      m.new_str=m.old_str
  ENDCASE
  m.new_text=STRTRAN(m.new_text,m.old_str,m.new_str)
  m.at_pos2=m.at_pos+LEN(m.new_str)
  IF m.at_pos2<=0
    EXIT
  ENDIF
  m.at_pos3=m.at_pos3+m.at_pos2
ENDDO
m.j=0
DO WHILE "{{"$m.new_text.AND."}}"$m.new_text
  m.i=LEN(m.new_text)
  m.new_text=evltxt(m.new_text)
  IF m.i=LEN(m.new_text)
    IF m.j>=2
      EXIT
    ENDIF
    m.j=m.j+1
  ENDIF
ENDDO
RETURN m.new_text

* END evltxt



FUNCTION evlstr(eval_str)

IF EMPTY(m.eval_str)
  RETURN m.eval_str
ENDIF
RETURN EVALUATE(m.eval_str)

* END evlstr



FUNCTION evlmsg(old_str)
LOCAL new_text,eval_str,var_type

IF TYPE("m.old_str")#"C"
  RETURN ""
ENDIF
IF .NOT.LEFT(m.old_str,1)=="@"
  RETURN m.old_str
ENDIF
m.eval_str=EVALUATE(SUBSTR(MLINE(m.old_str,1),2))
m.var_type=TYPE("m.eval_str")
DO CASE
  CASE m.var_type=="C"
    m.new_str=m.eval_str
  CASE m.var_type=="N"
    m.new_str=ALLTRIM(STR(m.eval_str,24,12))
    DO WHILE RIGHT(m.new_str,1)=="0"
      m.new_str=LEFT(m.new_str,LEN(m.new_str)-1)
      IF RIGHT(m.new_str,1)=="."
        m.new_str=LEFT(m.new_str,LEN(m.new_str)-1)
        EXIT
      ENDIF
    ENDDO
  CASE m.var_type=="D"
    m.new_str=DTOC(m.eval_str)
  CASE m.var_type=="L"
    m.new_str=IIF(m.eval_str,".T.",".F.")
  OTHERWISE
    m.new_str=m.old_str
ENDCASE
RETURN m.new_str

* END evlmsg



FUNCTION strexpr(eval_str)
LOCAL new_text,var_type

IF PARAMETERS()=0
  RETURN ""
ENDIF
m.var_type=TYPE("m.eval_str")
DO CASE
  CASE m.var_type=="C"
    m.new_str=m.eval_str
  CASE m.var_type=="N"
    m.new_str=ALLTRIM(STR(m.eval_str,24,12))
    DO WHILE RIGHT(m.new_str,1)=="0"
      m.new_str=LEFT(m.new_str,LEN(m.new_str)-1)
      IF RIGHT(m.new_str,1)=="."
        m.new_str=LEFT(m.new_str,LEN(m.new_str)-1)
        EXIT
      ENDIF
    ENDDO
  CASE m.var_type=="D"
    m.new_str=DTOC(m.eval_str)
  CASE m.var_type=="L"
    m.new_str=IIF(m.eval_str,".T.",".F.")
ENDCASE
RETURN m.new_str

* END strexpr



FUNCTION insert(filename)
LOCAL lstselect,filestring,tempalias

IF .NOT.FILE(m.filename)
  RETURN ""
ENDIF
m.lstselect=SELECT()
m.tempalias="_"+SYS(3)
IF USED(m.tempalias)
  SELECT (m.tempalias)
  LOCATE
ELSE
  CREATE CURSOR (m.tempalias) (FILEINFO M)
  SELECT (m.tempalias)
  INSERT BLANK
ENDIF
APPEND MEMO FILEINFO FROM (m.filename) OVERWRITE
filestring=FILEINFO
USE IN (m.tempalias)
SELECT (m.lstselect)
RETURN filestring

* END insert