288 lines
7.8 KiB
Plaintext
288 lines
7.8 KiB
Plaintext
* Program....: HtmlMerge.prg
|
|
* Version....: 1.1
|
|
* Author.....: Maurice de Beijer
|
|
* Date.......: September 1, 1999
|
|
* Notice.....: Copyright (c) 1999-2000 ABL, All Rights Reserved.
|
|
* Compiler...: Visual FoxPro 06.00.8492.00 for Windows
|
|
* Abstract...: Merge a HTML template with the current cursor
|
|
* Changes....:
|
|
* Useage.....:
|
|
*
|
|
* SELECT *, ;
|
|
* '<A HREF="http://localhost/default.htm">' + eng_name + '</A>' AS Link ;
|
|
* FROM (ADDBS(_SAMPLES) + 'Data\Products') ;
|
|
* WHERE !Discontinu ;
|
|
* ORDER BY Eng_Name ;
|
|
* INTO CURSOR cProd NOFILTER
|
|
* * Create the HTML merge object
|
|
* loHTML = NewObject('HTMLMerge', 'HTMLMerge.prg')
|
|
* * Read the first template
|
|
* lcText = FILETOSTR('Template_1.htm')
|
|
* * Merge it with the cursor of products
|
|
* loHTML.ScanMerge(lcText)
|
|
* * Save the result as Demo_1.htm
|
|
* STRTOFILE(loHTML.cHTML, 'demo_1.htm')
|
|
*
|
|
* Note.......:
|
|
*
|
|
* May 17, 2000
|
|
* Add the check for NoScan atributes.
|
|
* If a table or list containes a NoScan attribute this will be ignored when determining the table/list to scan.
|
|
* This is usefull when you use a table to format a page header and use a second table below this which
|
|
* you want to scan. To use it just add a NoScan attribute to any table/list above the table/list you want to
|
|
* use in the scan loop.
|
|
|
|
|
|
********************************
|
|
DEFINE CLASS HTMLMerge AS Custom
|
|
********************************
|
|
|
|
* The final HTML Text
|
|
cHTML = ''
|
|
|
|
|
|
*******************************
|
|
PROCEDURE ScanMerge(tcTemplate)
|
|
*******************************
|
|
* Look for the first table or list in the template
|
|
* The first item is merged with every line in the current cursor
|
|
LOCAL lnTable, lnList, lnFirst
|
|
|
|
lnTable = THIS.GetScanTagPos('<TABLE', tcTemplate)
|
|
IF lnTable = 0
|
|
* No table found
|
|
lnTable = 99999999
|
|
ENDIF
|
|
|
|
lnList = THIS.GetScanTagPos('<OL', tcTemplate)
|
|
IF lnList = 0
|
|
* No numbered list found, check for an bullet list
|
|
lnList = THIS.GetScanTagPos('<UL', tcTemplate)
|
|
IF lnList = 0
|
|
* No list found at all
|
|
lnList = 99999999
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF lnTable < lnList
|
|
* Table found before any list
|
|
THIS.MergeTable(tcTemplate, lnTable)
|
|
ELSE
|
|
* List found before any table
|
|
THIS.MergeList(tcTemplate, lnList)
|
|
ENDIF
|
|
|
|
RETURN
|
|
|
|
|
|
********************************************
|
|
PROCEDURE MergeTable(tcTemplate, tnStartPos)
|
|
********************************************
|
|
* Merge the body of a HTML table with every record
|
|
* in the current cursor
|
|
LOCAL lcTemplate, lnAtPos, lcTable, lcText
|
|
lcTemplate = tcTemplate
|
|
IF VARTYPE(tcStartPos) = 'N'
|
|
* Start position laready known
|
|
lnAtPos = tnStartPos
|
|
ELSE
|
|
* Start position not known yet, find it
|
|
lnAtPos = THIS.GetScanTagPos('<TABLE', lcTemplate)
|
|
ENDIF
|
|
|
|
* Is there a table ?
|
|
IF lnAtPos > 0
|
|
* Table found, first do the header
|
|
lcText = LEFT(lcTemplate, lnAtPos - 1)
|
|
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
|
THIS.Merge(lcText)
|
|
|
|
* Extract the whole table part stopping just
|
|
* before the end table marker
|
|
lnAtPos = ATCC('</TABLE>', lcTemplate)
|
|
lcTable = LEFT(lcTemplate, lnAtPos - 1)
|
|
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
|
|
|
lnAtPos = ATCC('<TR', lcTable)
|
|
IF lnAtPos > 0
|
|
* Take care of the starting <TABLE ... > tag
|
|
lcText = LEFT(lcTable, lnAtPos - 1)
|
|
lcTable = SUBSTR(lcTable, lnAtPos)
|
|
THIS.Merge(lcText)
|
|
ENDIF
|
|
|
|
DO WHILE ATCC('<TH', lcTable) > 0
|
|
* Extract the headers and merger them
|
|
lnAtPos = ATCC('</TR>', lcTable)
|
|
lcText = LEFT(lcTable, lnAtPos + 5)
|
|
lcTable = SUBSTR(lcTable, lnAtPos + 5)
|
|
THIS.Merge(lcText)
|
|
ENDDO
|
|
|
|
SCAN
|
|
* Merge the remainig body of the table for each record
|
|
THIS.Merge(lcTable)
|
|
ENDSCAN
|
|
ENDIF
|
|
|
|
* Expand the remainder of the template
|
|
THIS.Merge(lcTemplate)
|
|
|
|
RETURN THIS.cHTML
|
|
|
|
|
|
*******************************************
|
|
PROCEDURE MergeList(tcTemplate, tnStartPos)
|
|
*******************************************
|
|
LOCAL lcTemplate, lnAtPos, lcTable, lcText
|
|
lcTemplate = tcTemplate
|
|
IF VARTYPE(tcStartPos) = 'N'
|
|
* Start position laready known
|
|
lnAtPos = tnStartPos
|
|
ELSE
|
|
* Start position not known yet, find it
|
|
lnAtPos = THIS.GetScanTagPos('<OL', lcTemplate)
|
|
IF lnAtPos = 0
|
|
lnAtPos = THIS.GetScanTagPos('<UL', lcTemplate)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
* Is there a list ?
|
|
IF lnAtPos > 0
|
|
* Table found, first do the header
|
|
lcText = LEFT(lcTemplate, lnAtPos - 1)
|
|
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
|
THIS.Merge(lcText)
|
|
|
|
* Extract the whole table part
|
|
lnAtPos = ATCC('</OL>', lcTemplate)
|
|
IF lnAtPos = 0
|
|
lnAtPos = ATCC('</UL>', lcTemplate)
|
|
ENDIF
|
|
lcTable = LEFT(lcTemplate, lnAtPos - 1)
|
|
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
|
|
|
|
lnAtPos = ATCC('<LI', lcTable)
|
|
IF lnAtPos > 0
|
|
* Take care of the <TABLE> tag
|
|
lcText = LEFT(lcTable, lnAtPos - 1)
|
|
lcTable = SUBSTR(lcTable, lnAtPos)
|
|
THIS.Merge(lcText)
|
|
ENDIF
|
|
|
|
SCAN
|
|
* Merge the body for each record
|
|
THIS.Merge(lcTable)
|
|
ENDSCAN
|
|
ENDIF
|
|
|
|
* Expand the remainder of the template
|
|
THIS.Merge(lcTemplate)
|
|
|
|
RETURN THIS.cHTML
|
|
|
|
|
|
*************************
|
|
PROCEDURE Write(tcString)
|
|
*************************
|
|
* Add a string to the output
|
|
|
|
THIS.cHTML = THIS.cHTML + TRANSFORM(tcString)
|
|
|
|
RETURN
|
|
|
|
*************************
|
|
PROCEDURE WriteLine(tcString)
|
|
*************************
|
|
* Add a string and new line to the output
|
|
|
|
* Write the line
|
|
THIS.Write(tcString)
|
|
* Write the cariage return
|
|
THIS.Write(CHR(13)+CHR(10))
|
|
|
|
RETURN
|
|
|
|
|
|
*****************
|
|
PROCEDURE Clear()
|
|
*****************
|
|
* Clear all output
|
|
|
|
THIS.cHTML = ''
|
|
|
|
RETURN
|
|
|
|
|
|
***********************
|
|
PROCEDURE Merge(tcText)
|
|
***********************
|
|
* Merge a template with the embedded Visual FoxPro expressions
|
|
LOCAL lcText, lnAtPos1, lnAtPos2, lcEval, lcValue
|
|
lcText = tcText
|
|
lcText = STRTRAN(lcText, '<%', '<%')
|
|
lcText = STRTRAN(lcText, '%>', '%>')
|
|
|
|
* Loop while another expression is found
|
|
DO WHILE ATCC('<%=', lcText) > 0
|
|
* Get the start and end position of the next expression
|
|
lnAtPos1 = ATCC('<%=', lcText)
|
|
lnAtPos2 = ATCC('%>', lcText)
|
|
|
|
* Extract the next expression
|
|
lcEval = SUBSTR(lcText, lnAtPos1 + 3, lnAtPos2 - lnAtPos1 - 3)
|
|
* Remove any cariage returns from the expression as they could be inserted by an HTML editor
|
|
lcEval = CHRTRAN(lcEval, CHR(13) + CHR(10), '')
|
|
|
|
* Evaluate it
|
|
lcValue = TRANSFORM(EVALUATE(lcEval))
|
|
* Stuff the result back instead of the original expression
|
|
lcText = STUFFC(lcText, lnAtPos1, lnAtPos2 - lnAtPos1 + 2, lcValue)
|
|
ENDDO
|
|
|
|
* Add it to the current HTML
|
|
THIS.Write(lcText)
|
|
|
|
* Return the result
|
|
RETURN lcText
|
|
|
|
|
|
******************************************
|
|
PROCEDURE GetScanTagPos(tcTag, tcTemplate)
|
|
******************************************
|
|
* Find the required scan tag, ignore all tags containing a NoScan attribute
|
|
LOCAL lnResult, lnPos, lnAtPos1, lnAtPos2, lcTemp
|
|
lnResult = 0
|
|
lnPos = 1
|
|
|
|
DO WHILE .T.
|
|
* Find the next position
|
|
lnAtPos1 = ATCC(tcTag, tcTemplate, lnPos)
|
|
IF lnAtPos1 > 0
|
|
* Found another tag to test, extract the rest of the string
|
|
lcTemp = SUBSTR(tcTemplate, lnAtPos1)
|
|
* Find the end of the tag
|
|
lnAtPos2 = ATCC('>', lcTemp)
|
|
* And determine the complete tag
|
|
lcTemp = LEFT(lcTemp, lnAtPos2)
|
|
|
|
* Check if we are to ignore this tag during the scan operation
|
|
IF ATCC('NoScan', lcTemp) = 0
|
|
* No NoScan attribute on this tag, use it
|
|
lnResult = lnAtPos1
|
|
EXIT
|
|
ELSE
|
|
* Try to find a next tag
|
|
lnPos = lnPos + 1
|
|
ENDIF
|
|
ELSE
|
|
* Didn't find the required tag, stop
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
|
|
|
|
RETURN lnResult
|
|
|
|
ENDDEFINE
|