new example - Check Boxes, Subclassing

Coordinator
Oct 19, 2010 at 10:37 PM
Edited Oct 25, 2010 at 5:05 PM

Here's an example that might be useful to someone:

http://www.thetechconsult.com/mctg/default.aspx

User: Dentsply   Password: D   (case sensitive)

It shows a few useful techniques that may be helpful:

1.)  Use Javascript to Post data for any action (like paging, sorting, etc) so that the state of check boxes is always saved to the Session.

2.)  Subclass the HTMLtable method (from the AVFPhtml class in activevfp.prg) in main.prg so that #1 can be accomplished without modifying activevfp.dll.

Here is the main.prg:

#DEFINE crlf CHR(13)+CHR(10)
***********************************
* Mainline entry point of the app
************************************
LOCAL lchtmlfile,lchtmlout

AVFPinit() && set data and HTML paths

* process the request from the URL
oProp.Action=oRequest.querystring("action")
DO CASE

CASE oProp.Action=='sessionlist'

lcHTMLout= sessionlist()

CASE oProp.Action=='Process'

SaveOrder()

* MESSAGEBOX("Processing Complete.","Notify",64,1000)

lcHTMLout= sessionlist()

CASE oProp.Action=='deletesearch'
oSession.VALUE("thissort","")
oSession.VALUE("thisKeyWord","")
oResponse.Redirect(oProp.ScriptPath+[?action=sessionlist])

CASE oProp.Action=='pdf'
LOCAL lcFile,lcNewPath
oPDF=CREATEOBJECT("pdfrun.print2pdf")
if isnull(oPDF)
return .f.
endif
oUtil=NEWOBJECT('AVFPutilities')
* files older than 20 Minutes(1200 ms.), erase. 3rd param is path - can be hardcoded
oUtil.DeleteFiles('pdf',1200,STRTRAN(oProp.AppStartPath,oProp.AppName,oProp.AppName+'r\pdffiles\'))
lcCompany=oRequest.Form("Company")
IF ISNULL(lcCompany) .OR. EMPTY(lcCompany)
oPDF.cRecordSelect = [SELECT * from ']+ oProp.DataPath+[customer' INTO CURSOR tcursor]
ELSE
oPDF.cRecordSelect = [SELECT * from '] + oProp.DataPath+[customer' ]+;
[WHERE UPPER(company)=ALLTRIM(UPPER(']+lcCompany+[')) INTO CURSOR tcursor]
ENDIF
* the following properties are coded for portability. They may be hardcoded instead.
oPDF.cReport = oProp.AppStartPath+"\reports\listcust.frx"
*oPDF.cPhysicalPath=[C:\avfpdemo4\avfpdemo4r\pdffiles\]
*oPDF.cLogicalPath=[/avfpdemo4v2r/pdffiles/]
oPDF.cPhysicalPath=STRTRAN(oProp.AppStartPath,oProp.AppName,oProp.AppName+'r\pdffiles\',OCCURS(oProp.AppName,oProp.AppStartPath))
oPDF.cLogicalPath=STRTRAN(SUBSTR(oProp.ScriptPath,1,ATC('default.',oProp.ScriptPath)-2),oProp.AppName,oProp.AppName+'r/pdffiles/',OCCURS(oProp.AppName,oProp.ScriptPath))
lcFile=oPDF.GetOutput() && generate output, return temp file name
lcNewPath=oPDF.cLogicalPath+lcFile && new URL
oResponse.Redirect(lcNewPath) && redirect browser to created file
oPDF = .NULL.
release oPDF

CASE oProp.Action=='pdfthread'
cEventID=oAsync.CreateThread("PDFthread") &&PDFthread is the prg that contains the code for the background thread

CASE oProp.Action=='readcookie'
IF EMPTY(oRequest.cookies("ActiveVFP"))
oSession.VALUE("hasCookie",.F.)
ELSE
oSession.VALUE("hasCookie",.T.)
ENDIF
* increment a counter in a cookie
oCookie.WRITE("counter",VAL(oRequest.cookies("counter"))+1,"January 1, 2035")
lcHTMLfile = 'cookie.htm'
lcHTMLout= FILETOSTR(oProp.HtmlPath+lcHTMLfile)
lcHTMLout= oHTML.mergetext(lcHTMLout)

CASE oProp.Action=='createcookie'
IF .NOT. EMPTY(oRequest.FORM("T1")) && value from HTML form
oCookie.WRITE("ActiveVFP",oRequest.FORM("T1"))
ENDIF
oResponse.Redirect(oProp.ScriptPath+[?action=readcookie])

CASE oProp.Action=='deletecookie'
oCookie.Delete("ActiveVFP")
oResponse.Redirect(oProp.ScriptPath+[?action=readcookie])

CASE oProp.Action=='DeleteCounter'
oCookie.DELETE("counter")
oResponse.Redirect(oProp.ScriptPath+[?action=readcookie])

CASE oProp.Action=='DeletemKey'
oCookie.DELETE("mkey")
oSession.VALUE("authenticated",.F.)
oResponse.Redirect(oProp.ScriptPath)

CASE oProp.Action=='Async' && start the long running task

cEventID=oAsync.CreateThread("MyThreadFunc") &&MyThreadFunc is the prg that contains the code for the task

CASE oProp.Action=='AsyncCheck' && check the long running task

LOCAL lcHTMLfile,lcHTMLout,lcNewPath, cEventID, lfin,test,test2, lstart, llFirst
PRIVATE cMeta,cCancel,cMess
cEventID=oRequest.QueryString("asyncID")

IF oAsync.Check(cEventID) && it finished or there is an error
IF !EMPTY(oAsync.oEvent.returnval) && a file name is there, redirect to it
lcNewPath=STRTRAN(SUBSTR(oProp.ScriptPath,1,ATC('default.',oProp.ScriptPath)-2),oProp.AppName,oProp.AppName+'r/pdffiles/',OCCURS(oProp.AppName,oProp.ScriptPath))
lcNewPath=lcNewPath+ALLTRIM(oAsync.oEvent.returnval) && new URL
oResponse.Redirect(lcNewPath)
ELSE && else just return 'finished' or error text
count=0
cMess=[]
cMeta=[]
cCancel=[]
IF oAsync.oEvent.err &&error
cMess=[ERROR! ]+ALLTRIM(TRANSFORM(oAsync.oEvent.err_txt))+;
[<input onclick="window.location = ']+ALLTRIM(oProp.ScriptPath)+[';" type="button" value="Go Back" />] &&
ELSE &&finished
STORE MEMLINES(oAsync.oEvent.action) TO gnNumLines && Number of lines in memo field
FOR count = 1 TO gnNumLines && Loop for # of lines in memo field
cMess=cMess+TRANSFORM(ALLTRIM(MLINE(oAsync.oEvent.action,count)))+[
] && list each line
NEXT
cMess=cMess+;
[<input onclick="window.location = ']+ALLTRIM(oProp.ScriptPath)+[';" type="button" value="Go Back" />] &&
ENDIF
ENDIF
ELSE && not finished, keep checking
count=0
cMess=[]
cMeta=[]
cCancel=[
CANCEL the Request]
cMess=[Running:...]+REPLICATE(".",oAsync.oEvent.count)+ALLTRIM(STR(oAsync.oEvent.count))+[
]
STORE MEMLINES(oAsync.oEvent.action) TO gnNumLines && Number of lines in memo field
FOR count = 1 TO gnNumLines && Loop for # of lines in memo field
cMess=cMess+TRANSFORM(ALLTRIM(MLINE(oAsync.oEvent.action,count)))+[
] && list each line
NEXT
ENDIF

lcHTMLfile = 'processing.htm'
lcHTMLout= FILETOSTR(oProp.HtmlPath+lcHTMLfile)
lcHTMLout= oHTML.mergetext(lcHTMLout)

CASE oProp.Action=='AsyncCancel'
LOCAL lcHTMLfile,lcHTMLout
PRIVATE cEventID,cMeta,cCancel,cMess
cEventID=oRequest.QueryString("asyncID")

oAsync.Cancel(cEventID)
cMeta=[]
cCancel=[]
cMess=[Action canceled by the user! ]+;
[<input onclick="window.location = ']+ALLTRIM(oProp.ScriptPath)+[';" type="button" value="Go Back" />] &&
lcHTMLfile = 'processing.htm'
lcHTMLout= FILETOSTR(oProp.HtmlPath+lcHTMLfile)
lcHTMLout= oHTML.mergetext(lcHTMLout)

CASE oProp.Action=='LogOut'
oSession.VALUE("authenticated",.F.)
oResponse.Redirect(oProp.ScriptPath)

CASE oProp.Action=='authenticate'
IF EMPTY(oRequest.servervariables("AUTH_USER"))
oResponse.BUFFER = .T.
oResponse.CLEAR
oResponse.STATUS = "401 Unauthorized"
oResponse.AddHeader("WWW-Authenticate","BASIC")
oResponse.END
lcHTMLout = [You need a valid logon and password to access this application.;
<input onclick="history.back()" type="button" value="Go Back" />]
ELSE
lcHTMLout=[Congratulations! You're authenticated.;
<input onclick="history.back()" type="button" value="Go Back" />]
ENDIF

CASE oProp.Action == 'listing'
lcHTMLout= listing()

CASE oProp.Action == 'login'
lcHTMLout= login()

OTHERWISE

CookieLogin() && checks for cookie to authenticate
lcHTMLfile = 'default.htm'
lcHTMLout= FILETOSTR(oProp.HtmlPath+lcHTMLfile)
lcHTMLout= oHTML.mergetext(lcHTMLout)

ENDCASE
* end mainline

* now we'll return the HTML output to the browser
RETURN lcHTMLout



************************************************************************
************************************************************************

* SessionList

*********************************

*** Function: Create an HTML record list with search and sort using session object

************************************************************************
FUNCTION sessionlist
LOCAL lcHTMLfile,lcHTMLout,lcOrder,lcKeyWord,lnCount
* always save any changes
UpdateSession()


* Use this code in each method you want to protect
CookieLogin() && checks for cookie to authenticate
IF !(oSession.VALUE("authenticated")) && check dbf authentication
lcHTMLfile = 'default.htm'
oSession.VALUE("previous",oProp.Action) && save page link
lcHTMLout=FILETOSTR(oProp.HtmlPath+lcHTMLfile)
RETURN oHTML.mergetext(lcHTMLout)
ENDIF

lcOrder=""
lcKeyWord="'"+UPPER(NVL(oRequest.FORM("keyword"),"")+"'")
IF lcKeyWord= "''"
lcKeyWord = oSession.VALUE("thisKeyWord")
ENDIF
Customer = oSession.VALUE("account")
IF ISNULL(Customer) &&9/3 CF
oSession.Value("errormsg","Your session has timed out because of inactivity. Please login again.")
oResponse.Redirect(oProp.ScriptPath)
ENDIF

lcKeyWord="'"+UPPER(NVL(oRequest.FORM("keyword"),"")+"'")
IF lcKeyWord= "''"
lcKeyWord = oSession.VALUE("thisKeyWord")
ENDIF
* Sort By
DO CASE
CASE oRequest.Form("type")=="division"
lcOrder= "division, uploadshistory.inv_no ASC, uploadshistory.invoice ASC" && division order
CASE oRequest.Form("type")=="CODE"
lcOrder = "CODE, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC" && CODE order
CASE oRequest.Form("type") =="inv_no"
lcOrder = "inv_no, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="Payer_CODE"
lcOrder = "Payer_CODE, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="invoice"
lcOrder = "invoice, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="invdate"
lcOrder = "invdate, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="DueDate"
lcOrder = "DueDate, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="inv_amtdue"
lcOrder = "inv_amtdue, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="inv_status"
lcOrder = "inv_status, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="Statusdate"
lcOrder = "Statusdate, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="Dispute"
lcOrder = "Dispute, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
CASE oRequest.Form("type") =="Approve"
lcOrder = "Approve,"
CASE oRequest.Form("type") =="Pay"
lcOrder = "Pay, division ASC, uploadshistory.inv_no ASC, uploadshistory.invoice ASC"
OTHERWISE
lcOrder=oSession.VALUE("thissort")
IF (ISNULL(lcOrder) .OR. EMPTY(lcOrder))
lcOrder=[division, uploadshistory.inv_no ASC, uploadshistory.invoice ASC] &&default to existing order
ENDIF
ENDCASE
* save sort to session
oSession.VALUE("thissort",lcOrder)

whichdivision = oRequest.FORM("division")

IF (EMPTY(whichdivision) .OR. ISNULL(whichdivision))
IF (EMPTY(oSession.Value("selected")) .OR. ISNULL(oSession.Value("selected")))
whichdivision='All Divisions'
oSession.Value("selected",'All Divisions')
ELSE
whichdivision=oSession.Value("selected")
ENDIF
ELSE
oSession.Value("selected",whichdivision) && store to session
ENDIF

SET ENGINEBEHAVIOR 70

* division dropdown list
SELE ALLTRIM(division) as division FROM uploadshistory ORDER BY division group by division INTO CURSOR tCursor
cDivision=oHTML.HTMLdropDown('tCursor.division',;
'tCursor.division','division','',whichdivision,.F.)

IF .NOT. USED('uploadshistory')
USE ('uploadshistory') IN 0 SHARED
ENDIF
SELECT uploadshistory

IF whichdivision = "All Divisions"
SUM uploadshistory.inv_amtdue FOR uploadshistory.company = "Dentsply" AND EMPTY(uploadshistory.inv_status) TO sumtotal
SELECT ;
LEFT(uploadshistory.division,13)AS sButton, ;
uploadshistory.division, ;
uploadshistory.invoice, ;
uploadshistory.inv_amtdue, ;
uploadshistory.invdate, ;
IIF(uploadshistory.CODE='FEX',[],IIF(uploadshistory.CODE='NP',[], IIF(uploadshistory.CODE='RPS',[],''))) as code,;
0 AS Aged, ;
uploadshistory.inv_baldue, ;
uploadshistory.savings, uploadshistory.recovery, uploadshistory.excludepay, ;
uploadshistory.dept, uploadshistory.acct, uploadshistory.suffix, ;
uploadshistory.ibgl, uploadshistory.obgl, uploadshistory.thirdgl, ;
uploadshistory.Payer_CODE, ;
uploadshistory.duedate, ;
uploadshistory.Statusdate, ;
uploadshistory.inv_status, ;
uploadshistory.inv_no, ;
uploadshistory.trackno, ;
uploadshistory.purch_ord, ;
uploadshistory.uniqueid ,uploadshistory.dispute,uploadshistory.approve,uploadshistory.pay;
FROM uploadshistory ;
WHERE uploadshistory.company = "Dentsply" AND EMPTY(uploadshistory.inv_status) ;
GROUP BY uploadshistory.trackno ;
ORDER BY &lcOrder ;
INTO CURSOR WebTemp
ELSE
SUM uploadshistory.inv_amtdue FOR uploadshistory.company = "Dentsply" AND EMPTY(uploadshistory.inv_status);
AND uploadshistory.division = whichdivision TO sumtotal
SELECT ;
LEFT(uploadshistory.division,13)AS sButton, ;
uploadshistory.division, ;
uploadshistory.invoice, ;
uploadshistory.inv_amtdue, ;
uploadshistory.invdate, ;
IIF(uploadshistory.CODE='FEX',[],IIF(uploadshistory.CODE='NP',[], IIF(uploadshistory.CODE='RPS',[],''))) as code,;
0 AS Aged, ;
uploadshistory.inv_baldue, ;
uploadshistory.savings, uploadshistory.recovery, uploadshistory.excludepay, ;
uploadshistory.dept, uploadshistory.acct, uploadshistory.suffix, ;
uploadshistory.ibgl, uploadshistory.obgl, uploadshistory.thirdgl, ;
uploadshistory.Payer_CODE, ;
uploadshistory.duedate, ;
uploadshistory.Statusdate, ;
uploadshistory.inv_status, ;
uploadshistory.inv_no, ;
uploadshistory.trackno, ;
uploadshistory.purch_ord, ;
uploadshistory.uniqueid ,uploadshistory.dispute,uploadshistory.approve,uploadshistory.pay;
FROM uploadshistory ;
WHERE uploadshistory.company = "Dentsply" AND EMPTY(uploadshistory.inv_status) ;
AND uploadshistory.division = whichdivision ;
GROUP BY uploadshistory.trackno ;
ORDER BY &lcOrder ;
INTO CURSOR WebTemp
ENDIF
oHTMLmod=NEWOBJECT('AVFPhtmlMOD')
lcHTMLfile = 'sessionlist.htm'
lcHTMLout=FILETOSTR(oProp.HtmlPath+lcHTMLfile)
lcHTMLout= oHTMLmod.htmlTable('invoice',lcHTMLout,10,10,'#E5E5E5',.F.;
,VAL(oRequest.FORM("page")),oRequest.FORM("nav"))
lcHTMLout= oHTMLmod.mergetext(lcHTMLout)
*
RETURN lcHTMLout
ENDFUNC
************************************************************************
FUNCTION UpdateSession
lcCheck=oSession.VALUE("account")
IF ISNULL(lcCheck)
oSession.Value("errormsg","Your session has timed out because of inactivity. Please login again.")
oResponse.Redirect(oProp.ScriptPath)
ENDIF
FOR EACH lcFormVar IN oRequest.oRequest.FORM
lcVar = oRequest.oRequest.FORM(lcFormVar).item
IF ! ISNULL(lcFormVar) .and. ! EMPTY(lcFormvar)
IF ISNULL(lcVar) .OR. EMPTY(lcVar)
lcVar=.F.
ELSE
lcVar=.T.
ENDIF
oSession.VALUE(lcFormVar,lcVar)

ENDIF
NEXT
RETURN
ENDFUNC
************************************************************************
FUNCTION SaveOrder
lcCheck=oSession.VALUE("account")
IF ISNULL(lcCheck) &&9/3 CF
oSession.Value("errormsg","Your session has timed out because of inactivity. Please login again.")
oResponse.Redirect(oProp.ScriptPath)
ENDIF
UpdateSession()
*!* FOR EACH lcFormVar IN oRequest.oRequest.FORM
*!* lcVar = oRequest.oRequest.FORM(lcFormVar).item
*!* IF lcFormVar <> [keyword] .and. lcFormVar <> [bbb] .and. ! ISNULL(lcFormVar) .and. ! EMPTY(lcFormvar) && the search textbox & submit value
*!* UPDATE &lcTable set amt_next =VAL(lcVar) WHERE cat=lcFormVar
*!* ENDIF
*!* NEXT
*!* IF oRequest.form("hiddenName")="Save"
*!* order_success()
*!* ENDIF

*!* FOR EACH lcFormVar IN oRequest.oRequest.FORM
*!* lcVar = oRequest.oRequest.FORM(lcFormVar).item
*!* IF ! ISNULL(lcFormVar) .and. ! EMPTY(lcFormvar)
FOR EACH lcFormVar in oSession.Contents
DO CASE
CASE [dispute] $ lcFormVar
lcInvoice=STREXTRACT(lcFormVar,[dispute_],[_]) &&parse lcFormVar (name_invoice_code)
lcCode=STREXTRACT(lcFormVar,lcInvoice+[_])
*!* IF ISNULL(lcVar) .OR. EMPTY(lcVar)
*!* llDispute=.F.
*!* ELSE
*!* llDispute=.T.
*!* ENDIF
UPDATE UploadsHistory ;
SET UploadsHistory.dispute = oSession.Contents(lcFormVar) ;
WHERE UploadsHistory.invoice = lcInvoice AND ;
RTRIM(UploadsHistory.code) = RTRIM(lcCode)

CASE [approve] $ lcFormVar
lcInvoice=STREXTRACT(lcFormVar,[approve_],[_]) &&parse lcFormVar (name_invoice_code)
lcCode=STREXTRACT(lcFormVar,lcInvoice+[_])
*!* IF ISNULL(lcVar) .OR. EMPTY(lcVar)
*!* llApprove=.F.
*!* ELSE
*!* llApprove=.T.
*!* ENDIF
UPDATE UploadsHistory ;
SET UploadsHistory.approve = oSession.Contents(lcFormVar);
WHERE UploadsHistory.invoice = lcInvoice AND ;
RTRIM(UploadsHistory.code) = RTRIM(lcCode)

CASE [pay] $ lcFormVar
lcInvoice=STREXTRACT(lcFormVar,[pay_],[_]) &&parse lcFormVar (name_invoice_code)
lcCode=STREXTRACT(lcFormVar,lcInvoice+[_])
*!* IF ISNULL(lcVar) .OR. EMPTY(lcVar)
*!* llPay=.F.
*!* ELSE
*!* llPay=.T.
*!* ENDIF
UPDATE UploadsHistory ;
SET UploadsHistory.pay = oSession.Contents(lcFormVar) ;
WHERE UploadsHistory.invoice = lcInvoice AND ;
RTRIM(UploadsHistory.code) = RTRIM(lcCode)

UPDATE UploadsHistory ;
SET UploadsHistory.inv_status = "IP", ;
UploadsHistory.statusdate = DATE() ;
WHERE UploadsHistory.invoice = lcInvoice AND ;
RTRIM(UploadsHistory.code) = RTRIM(lcCode) ;
AND oSession.Contents(lcFormVar)=.T.
OTHERWISE
ENDCASE
*ENDIF
NEXT


RETURN
ENDFUNC
************************************************************************
FUNCTION order_success
************************************************************************

oSession.VALUE("csvfile",SUBSTR(SYS(2015), 3, 10)+[.csv])
COPY to [C:\Program Files\ActiveVFP\overdevest\Overdevestr\csvfiles\]+oSession.value("csvfile") FIELDS descript, grade, pric, amt_next for !EMPTY(amt_next) TYPE CSV
UPDATE password set csvfile=oSession.value("csvfile") WHERE account=oSession.VALUE("account")
oResponse.Redirect(oProp.ScriptPath+[?action=order_success])
ENDFUNC
************************************************************************
************************************************************************
* listing

*********************************

*** Function: demo dbf authentication check

************************************************************************
FUNCTION listing
LOCAL lcHTMLout,lcHTMLfile
* Use this code in each method you want to protect
CookieLogin() && checks for cookie to authenticate
IF !(oSession.VALUE("authenticated")) && check dbf authentication
lcHTMLfile = 'default.htm'
oSession.VALUE("previous",oProp.Action) && save page link
lcHTMLout=FILETOSTR(oProp.HtmlPath+lcHTMLfile)
RETURN oHTML.mergetext(lcHTMLout)
ENDIF
*
oResponse.Redirect(oProp.ScriptPath+[?action=sessionlist])
ENDFUNC
************************************************************************

************************************************************************

* login

*********************************

*** Function: login the user by authenticating against a dbf

************************************************************************
FUNCTION login
TableAuth(ALLTRIM(oRequest.FORM("Login")),ALLTRIM(oRequest.FORM("Password")),oRequest.FORM("C1"))
RETURN listing()
ENDFUNC
************************************************************************

* cookielogin

*********************************

*** Function: authenticate against a dbf using cookie

************************************************************************
FUNCTION CookieLogin
LOCAL lcKey
lcKey=ALLTRIM(oRequest.cookies('mkey'))
IF ! EMPTY(lcKey) .AND. oSession.VALUE("authenticated")= .F.
IF .NOT. USED('mcookies')
USE ('mcookies') IN 0 SHARED
ENDIF
SELECT mcookies
SET ORDER TO KEY
SET EXACT ON
SEEK lcKey
SET EXACT OFF
IF ! EOF()
TableAuth(mcookies.USER,mcookies.PASS,"")
ENDIF
ENDIF
RETURN
ENDFUNC
************************************************************************

* TableAuth

*********************************

*** Function: authenticate against a dbf

************************************************************************
FUNCTION TableAuth
LPARAMETERS lcName,lcPassWord,lcAutoLogin
LOCAL lcNewKey,lcPrev,lcFirst
*IF .NOT. USED('srvccust')
* USE ('srvccust') IN 0 SHARED
*ENDIF
*SELECT srvccust
*SET ORDER TO username
*SET EXACT ON
*SEEK UPPER(PADR(ALLTRIM(lcName),LEN(srvccust.Username),' '))
*SET EXACT OFF
IF ALLTRIM(lcName)="Dentsply" &&FOUND() .AND. !EMPTY(lcName)

IF UPPER(ALLTRIM(m.lcPassWord))=[D]&&UPPER(ALLTRIM(m.lcPassWord)) == UPPER(ALLTRIM(srvccust.Password))
oSession.VALUE("authenticated",.T.)
lcPrev = oSession.VALUE("previous")
oSession.VALUE("name", "Dentsply") &&srvccust.Contact)
oSession.VALUE("account",ALLTRIM("Dentsply")) &&srvccust.Username)) && CF 9/28 shorter accounts have embedded blanks
&&oSession.VALUE("gs",password.gs) add other values to session?

*added 8/17 for logging
&&REPLACE loggedin WITH DATETIME()

IF ! ISNULL(lcAutoLogin)
lcNewKey = SUBSTR(SYS(2015), 3, 10)
IF .NOT. USED('mcookies')
USE ('mcookies') IN 0 SHARED
ENDIF
SELECT mcookies
INSERT INTO mcookies (KEY, USER, PASS) VALUES (lcNewKey, lcName, lcPassWord)
oCookie.WRITE("mkey",lcNewKey,"January 1, 2055")
ENDIF
IF ISNULL(oRequest.querystring("page")) .OR. ISNULL(lcPrev)
lcHTMLfile = 'default.htm'
ELSE
IF lcPrev = [login]
lcPrev=[listing]
ENDIF
oResponse.Redirect(oProp.ScriptPath+[?action=];
+IIF(ISNULL(lcPrev),oProp.Action,lcPrev)) &&LOOP
ENDIF

ELSE
lcHTMLfile = 'default.htm'
ENDIF
ELSE
lcHTMLfile = 'default.htm'
ENDIF

HTML_Out=FILETOSTR(oProp.HTMLpath+lcHTMLfile)

HTML_Out=oHTML.mergetext(HTML_Out)
RETURN HTML_Out
ENDFUNC

************************************************************************
FUNCTION AVFPinit
* Set up data and html paths
************************************************************************
LOCAL lnOccur
IF INLIST(APPLICATION.STARTMODE,2,3,5) && regular server mode

* Set Data and HTML paths (adjust per your needs as necessary)
* lnOccur = OCCURS(oProp.AppName,oProp.AppStartPath) && establish last occurence
* lcDataPath=STRTRAN(oProp.AppStartPath,oProp.AppName,'Data\'+oProp.AppName,lnOccur)
SET PATH TO oProp.AppStartPath+'\data\AVFPdemo41\' && SET DEFA TO 'c:\mydata\' &lcDataPath
oProp.DataPath = oProp.AppStartPath+'\data\AVFPdemo41\' &&lcDataPath
oProp.HtmlPath=oProp.AppStartPath+'\HTML\' && oProp.cHTMLpath='c:\myHTML\'

ELSE && debugging mode (requires vfp7 or above)

* Set Data and HTML paths (adjust per your needs as necessary)
lcDataPath=STRTRAN(oProp.AppStartPath,oProp.AppName+'\PRG\','data\'+oProp.AppName+'\',1) && SET DEFA TO 'c:\mydata\'
SET PATH TO &lcDataPath
oProp.DataPath = lcDataPath
oProp.HtmlPath=STRTRAN(oProp.AppStartPath,'\PRG\','\HTML\') && oProp.cHTMLpath='c:\myHTML\'
ENDIF

*Check if authenticated
oSession.Value("authenticated",IIF(EMPTY(oSession.Value("authenticated"));
.OR. ISNULL(oSession.Value("authenticated")),.F.,oSession.Value("authenticated")))

RETURN

ENDFUNC
*********************************************************************************
DEFINE CLASS AVFPhtmlMOD AS AVFPhtml
*************************************************************
*********************************************************************************
************************************************************************
* AVFPhtml :: htmltable **MOD for Javascript pages submit as form post
************************************************************************
* HTMLTABLE - eval html tables
*
* Last Modified: 6/26/09
*
*** 1.) lcTableTag -Name of the HTML table (from in HTML)
*** 2.) lcHTMLtable -HTML table text to be evaluated
*** 3.) lnTotPerPage -Total number of records per page
*** 4.) lnpagenumbers-Include page numbers/# of page numbers to show(need to include lnStart and lcButton params)
*** 5.) lcBar -Alternating color for HTML table records (for example, #FFFFFF for white)
*** 6.) llTableRec -(fast write)&do a response.write - for fastest output(usually a large list on 1 page)
*** 7.) lnStart -Navigational - Page number to start list from, from URL
*** 8.) lcButton -Navigational - First, last, next, previous, from URL
************************************************************************
FUNCTION htmltable
LPARAMETERS lcTableTag,lcHTMLtable,lnTotPerPage,lnpagenumbers,lcBar,;
llTableRec,lnStart,lcButton
LOCAL lnRowCount,lnTotPages,lnAtPos,lnAtPos1,lnAtPos2,lcHTML,;
lnPageMax,lnPageBegin,lcPages,lnOccur,lcHTMLstr,lcStr1,lcStr2,;
lnCount,lnX,lnZ,lcBarStr,lcDivStart,lcDivEnd, llpagenumbers
IF lnpagenumbers > 0 .AND. ISNULL(lnpagenumbers) != .T.
llpagenumbers=.T.
ELSE
llpagenumbers=.F.
ENDIF
lcHTML=''
lcHTMLstr=lcHTMLtable
lnAtPos1 = ATC('<'+ALLTRIM(lcTableTag)+'>', lcHTMLstr)
IF lnAtPos1 = 0
lnAtPos1 = ATC('<'+ALLTRIM(lcTableTag)+'>', lcHTMLstr)
lcDivStart=THIS.GetString(SUBSTR(lcHTMLstr,lnAtPos1),;
'<'+ALLTRIM(lcTableTag)+'>','', lcHTMLstr) lcDivEnd=THIS.GetString(SUBSTR(lcHTMLstr,lnAtPos1),; '
','<!--'+ALLTRIM(lcTableTag)+'-->')
ELSE
lcDivEnd=THIS.GetString(SUBSTR(lcHTMLstr,lnAtPos1),;
'','</'+ALLTRIM(lcTableTag)+'>')
ENDIF
lnOccur=OCCURS('lnAtPos1 .AND. lnAtPos< lnATPos2 EXIT ENDIF ENDFOR IF lnAtPos > 0 lcStr1 = LEFT(lcHTMLstr, lnAtPos - 1) lcHTMLstr = SUBSTR(lcHTMLstr, lnAtPos) lnAtPos = ATC('
', lcHTMLstr)
lcStr2 = LEFT(lcHTMLstr, lnAtPos - 1)
lcHTMLstr = SUBSTR(lcHTMLstr, lnAtPos)
IF llTableRec
lcTableStr="")+">" ENDIF lnAtPos = ATC(' 0 lcStr1 = LEFT(lcStr2, lnAtPos - 1) lcStr2 = SUBSTR(lcStr2, lnAtPos) lcHTML = lcHTML + THIS.mergetext(lcStr1) ENDIF DO WHILE ATC(' 0 lnAtPos = ATC('', lcStr2) lcStr1 = LEFT(lcStr2, lnAtPos + 5) lcStr2 = SUBSTR(lcStr2, lnAtPos + 5) lcHTML = lcHTML + IIF(llTableRec,lcTableStr+THIS.mergetext(lcStr1)+[
],;
THIS.mergetext(lcStr1))
ENDDO
lnRowCount = RECCOUNT()
RELEASE START
PUBLIC START
IF llpagenumbers
START = NVL(lnStart,1)
IF START = 0
START= 1
ENDIF
lnPageMax = START * lnTotPerPage
lnPageBegin = (lnPageMax - lnTotPerPage)+1
IF lnRowCount < lnTotPerPage
lnTotPages = 1
ELSE
IF MOD(lnRowCount, lnTotPerPage) > 0
lnTotPages = INT(lnRowCount / lnTotPerPage) + 1
ELSE
lnTotPages = INT(lnRowCount / lnTotPerPage)
ENDIF
ENDIF
oSession.value("totpages",lnTotPages)
DO CASE
CASE lcButton="First"
START=1
lnPageBegin=1
lnPageMax=lnTotPerPage
CASE lcButton="Prev"
IF lnPageBegin < 1 .OR. START -1 = 0
START=1
lnPageBegin=1
lnPageMax=lnTotPerPage
ELSE
START=START-1
lnPageBegin=lnPageBegin-lnTotPerPage
lnPageMax=lnPageMax-lnTotPerPage
ENDIF
CASE lcButton="Next"
START=START+1
IF START>lnTotPages
START = lnTotPages
lnPageMax = START * lnTotPerPage
lnPageBegin = (lnPageMax - lnTotPerPage)+1
lnPageMax = lnRowCount
ELSE
lnPageBegin=lnPageBegin+lnTotPerPage
lnPageMax=lnPageMax+lnTotPerPage
ENDIF
CASE lcButton="Last"
START=lnTotPages
lnPageMax = START * lnTotPerPage
lnPageBegin = (lnPageMax - lnTotPerPage)+1
lnPageMax = lnRowCount
OTHERWISE
IF EMPTY(START)
START=1
lnPageBegin=1
lnPageMax=lnTotPerPage
ENDIF
ENDCASE
ELSE
START=1
lnPageBegin=1
lnPageMax=lnTotPerPage
ENDIF
IF llTableRec
lnTH=OCCURS('',lcHTMLtable)
lnTHat=AT('',lcHTMLtable,lnTH)
oResponse.Write(ALLTRIM(This.mergetext(SUBSTR(lcHTMLtable,1,lnTHat-1))+[]))
oResponse.Write(lcTableStr+This.mergetext(SUBSTR(lcHTMLtable,lnTHat,(lnTHat2-lnTHat)+5)))
ENDIF
FOR lnX = lnPageBegin TO IIF(llpagenumbers,lnPageMax,lnRowCount)

IF lnX <= lnRowCount
GOTO lnX
IF !EMPTY(lcBar)
IF MOD(lnX,2) = 0
lcBarStr=STRTRAN(lcStr2,[])
oResponse.Flush
ENDIF
ENDIF
ENDFOR
IF llTableRec
oResponse.Write([])
ELSE
lcHTML=THIS.mergetext(lcDivStart)+lcHTML+""+THIS.mergetext(lcDivEnd)
lcHTMLtable =STUFF(lcHTMLtable, lnAtPos1, lnAtPos2 - lnAtPos1+;
LEN(lcTableTag)+9, lcHTML)
IF llpagenumbers
lcPages=''
IF lnTotPages > 1
lngroupnumber = ceiling(START/lnpagenumbers)
FOR lnZ = lngroupnumber*lnpagenumbers-(lnpagenumbers-1) TO IIF(lnTotpages]+ALLTRIM(STR(lnZ))+[ ]+crlf
ELSE
*!* lcPages=lcPages+[ ]
lcPages=lcPages+[
]; && this is the MOD
+ALLTRIM(STR(lnZ))+[
]+crlf
ENDIF
ENDFOR
ENDIF
lnAtPos = ATC("<Pages>",lcHTMLtable)
IF lnAtPos = 0
lnAtPos = ATC("",lcHTMLtable)
ENDIF
IF ! EMPTY(lcPages) .AND. lnAtPos > 0
lcHTMLtable= STUFF(lcHTMLtable,lnAtPos,13,lcPages)+crlf
ELSE
lcHTMLtable= STUFF(lcHTMLtable,lnAtPos,13,"")+crlf
ENDIF
ENDIF
ENDIF
ENDIF
RETURN lcHTMLtable
ENDFUNC
ENDDEFINE