Initial commit - tasks v1.1.14
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
287
programe/htmlmerge.prg
Normal file
287
programe/htmlmerge.prg
Normal file
@@ -0,0 +1,287 @@
|
||||
* 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
|
||||
Reference in New Issue
Block a user