#INCLUDE wconnect.h

*************************************************************
DEFINE CLASS wwResponse AS RELATION
*************************************************************
*: Author: Rick Strahl
*:         (c) West Wind Technologies, 1999
*:Contact: http://www.west-wind.com
*************************************************************
#IF .F.
*:Help Documentation
*:Topic:
Class wwResponse

*:Description:
This class provides all output to your Web applications. This
is the base class with several implementation classes that 
live below it in the class hierarchy to provide the physical
HTTP output generation. The framework invokes these lower
level classes as appropriate for the appropriate server
operation mode.

Abstract class - doesn't implement any of the main write
methods.

*:ENDHELP
#ENDIF
*************************************************************

*** Flag that determines whether the object is running under ASP. This is mainly to custom handle headers.
lASPObject = .F.

*** Name of the AutoSession Cookie that is written when the header is written. Set by a client who wants to write this cookie.
cAutoSessionCookieName = WWWC_DEFAULT_SESSIONCOOKIE_NAME

*** Value of the AutoSession Cookie. Set by a client of this class to force this cookie to be written when the header is created
cAutoSessionCookie = ""

*** Determines whether the cookie is written as persistent
lAutoSessionCookiePersist = .F.

*** Cascading Stylesheet used in HTMLHeader
cStyleSheet = ""

*** Output stream string for COM operation
cOutput = .NULL.

*** ASP Compatibility - Assign just calls ContentTypeHeader()
ContentType = "text/html"

*** Set to turn off output that follows called by the Write method
lNoOutput = .F.

*** Determines if the Response object finished processing
ResponseEnded = .F.

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

***   Abstract methods that must be overridden in implementations

*************************************************************************
	
*** Writes Output to the HTTP stream
*********************************************************************
FUNCTION Write(lcText,llNoOutput)
*********************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::Write

*:Description:
The Write and FastWrite methods are used for all output that is sent to the
HTTP output stream. They are the low level methods through which all output
from the wwResponse object flows. All other methods of this object call
into Write or FastWrite to send their output into the HTTP stream. This
centralized access makes this object flexible and able to serve different
output mechanisms such as File or String or ASP Response object output by
changing only a few methods.

Write sends output as is without a trailing carriage return or other
formatting.

The optional lNoOutput parameter is used to avoid sending output to the
HTTP stream, returning a string as a result of the method instead. This
lNoOutput option is available on most  other wwResponse methods and passed
through to this method. This makes it possible to use wwResponse methods to
generate output strings directly.

*:Parameters:
<<b>>lcText<</b>>
Any kind of string based output that is to be placed in the HTTP output
stream. This data can be a string or binary data.

<<b>>llNoOutput<</b>>
When set to .T. output is not sent to file, instead returning the result as
a string.

*:Returns:
"" or the input string if llNoOutput is .T.
*:ENDHELP
#ENDIF

*********************************************************************
RETURN ""
ENDFUNC
* EOF wwResponse::Write

*** Same as Write - provided for backwards compatibility only
FUNCTION Send(lcText, llNoOutput)
RETURN ""
ENDFUNC


*** Same as Write - provided for ASP compatibility
FUNCTION BinaryWrite(lcText,llNoOutput)
RETURN this.Write(lcText,llNoOutput)


*********************************************************************
FUNCTION FastWrite(lcText,llNotUsed)
************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::FastWrite

*:Description:
This method is very similar to the <<%=
TopicLink("Write","wwResponse::Write") %>> method, but is more efficient as
it doesn't perform any error checking on the string and doesn't handle the
lNoOutput parameter.

*:Parameters:
<<b>>lcText<</b>>
Any kind of string based output that is to be placed in the HTTP output
stream. This data can be a string or binary data.

<<b>>llNotUsed<</b>>
A second parameter for the typical llNoOutput is provided for
compatibility, but is ignored.

*:ENDHELP
#ENDIF
*********************************************************************
RETURN ""
ENDFUNC
* EOF wwResponse::FastWrite

*********************************************************************
FUNCTION GetOutput(llNoClear)
*****************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::GetOutputNoClear

*:Description:
This method retrieves the currently accumulated HTTP stream output as a
string, but unlike the GetOutput method does not clear the HTTP stream.
This method is used internally to spy on the outgoing HTTP.

*:Returns:
String of the accumulated HTTP output.

*:ENDHELP
#ENDIF
*********************************************************************
RETURN ""
ENDFUNC
* EOF wwResponse::GetOutput

FUNCTION Render()
RETURN this.GetOutput()

*** Clears the HTTP output
FUNCTION Clear()
ENDFUNC

*** Same as Clear - included for backwards compatibility
FUNCTION Rewind()
ENDFUNC

*** resets the HTML object to its default state. Resets the
*** output to empty as well.
FUNCTION Reset()
ENDFUNC

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

***   Generic functional methods

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


	
	*-- Resets this object to its default state
FUNCTION reset
	STORE "" TO THIS.cAutoSessionCookie,THIS.cAutoSessionCookieName
	STORE .F. TO THIS.lNoOutput
ENDFUNC


*-- Generic header class that creates an HTTP Header, title, body tag and Headline
FUNCTION HTMLHeader
	************************************************************************
	* wwHTML :: HTMLHeader
	*********************************
	***  Function: Writes out a basic HTML Header
	***      Pass: tcHeader  -  Document Header Text.
	***                         If this string contains < > tags
	***                         the text is send as is, otherwise
	***            			    it's formatted to the <H1> </H1> tag
	***            tcDocName -  Browser Title String (displayed in caption)
   ***         tcBackground -
	***        tcContentType -  wwHTTPHeader Object  or
	***                         Content Type
	***                         others:
	***                         "TEXT/PLAIN"
	***                         "NONE"   (use when not generating plain
	***                                   non-CGI requests)
	***           tlNoOutput -  
	***
	***    Return: nothing or string if tlNoOutput is .T.
	************************************************************************
	LPARAMETERS tcHeader,tcTitle,tcBackground,tcContentType,tlNoOutput
	LOCAL lcOutText

	tcHeader=IIF(EMPTY(tcHeader),"",tcHeader)
	tcTitle=IIF(EMPTY(tcTitle),tcHeader,tcTitle)
	tcBackground=IIF(EMPTY(tcBackground),"",tcBackground)

	*** Write HTTP Header to output
	THIS.ContentType = tcContentType

	IF !EMPTY(tcBackground)
	   lcBackGround=IIF(AT("#",tcBackGround)>0,[BGCOLOR="],[BACKGROUND="])+;
	                    lower(tcBackground)+["]
	ELSE
	   lcBackground=""   
	ENDIF

	lcOutText=;
	   "<HTML>"+CRLF+"<HEAD><TITLE>"+;
	   tcTitle+"</TITLE></HEAD>"+CRLF+;
	   IIF(!EMPTY(THIS.cStyleSheet),[<LINK rel="stylesheet" type="text/css" href="] +  THIS.cStyleSheet +[">],"") +CRLF + ;
	   [<body ]+lcBackground+[ style="margin-left:5px;margin-right:5px;">]+CRLF

	*** Print Header Text or Graphic
	IF ATC("<",tcHeader)>0 AND ATC(">",tcHeader)>0
	   lcOutText=lcOutText+THIS.Write(tcHeader + CRLF,.T.) + CRLF
	ELSE
	   IF !EMPTY(tcHeader)
	      lcOutText=lcOutText+[<FONT FACE="Verdana"><H1>]+tcHeader+[</H1></Font><HR>] + CRLF
	   ENDIF
	ENDIF

	RETURN THIS.Write(@lcOutText,tlNoOutput)
ENDFUNC


************************************************************************
* wwResponse :: HTMLHeaderEx
****************************************
***  Function: Advanced HTML Header method
***    Assume:
***      Pass: lvHTMLHeader  - wwHTMLHeader Object or String (title)
***            loHTTPHeader  - wwHTTPHeader Object
***    Return: 
************************************************************************
FUNCTION HTMLHeaderEx
LPARAMETERS lvHTMLHeader, loHTTPHeader

THIS.ContentType = loHTTPHeader

IF VARTYPE(lvHTMLHeader) = "O"
   THIS.Write(lvHTMLHeader.GetOutput())
ELSE
   IF VARTYPE(lvHTMLHeader) = "C"
      THIS.Write("<html><head><title>" + lvHTMLHeader + "</title><body>")   
   ELSE
      THIS.Write("<html><body>")   
   ENDIF   
ENDIF

ENDFUNC
*  wwResponse :: HTMLHeaderEx

*********************************************************************
FUNCTION HTMLFooter(tcText,tlNoOutPut)
**************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::HTMLFooter

*:Description:
Creates a footer for a page. Creates </BODY></HTML> tags preceeded by
option HTML passed as parm. Optionally pass text to display just prior to
tags


*:Parameters:
<<b>>tcText<</b>>
Optional - HTML text to display just above the closing of the HTML
document. This can be handy for using a predefined template that gets
displayed on the bottom of every page. For example, the Web Connection Demo
uses a #DEFINE to create a string of a page footer that displays the 'Back
to Demo Page' and 'Show Code' links - these automatically get embedded onto
every page.

<<b>>llNoOutPut<</b>>
When set to .T. output is not sent to file, instead returning the result as
a string.

*:Returns:
"" if sending to file and the output text if lNoOuput is .T.
*:ENDHELP
#ENDIF
*********************************************************************

tcText=IIF(EMPTY(tcText),"",tcText)

RETURN THIS.Write(tcText+CRLF+"<p></BODY>"+CRLF+"</HTML>"+CRLF,tlNoOutput)
ENDFUNC
* EOF wwResponse::HTMLFooter




*********************************************************************
FUNCTION WriteLn(lcOutput,llNoOutput)
*************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::WriteLn

*:Description:
Writes output to the HTTP output stream with trailing carriage returns.
This is identical to:

<<pre>>Response.Write(tcText + CRLF)<</pre>>

but is easier to type and read. Use this for convenience, but keep in mind
there's a little overhead in WriteLn since it calls back onto the Write()
method to actually dump to the HTTP stream.

*:Parameters:
<<b>>lcText<</b>>
The text to output

<<b>>llNoOutput<</b>>
If .T. the string is returned back and no output is written into the HTTP
stream.

*:Returns:
"" or output string if llNoOutput is set.

#ENDIF
*********************************************************************
IF EMPTY(lcOutput)
  lcOutput=""
ENDIF  
RETURN THIS.Write(lcOutput+CRLF,llNoOutput)
ENDFUNC
* EOF wwResponse::WriteLn


*** Same as Writeln - backwards compatibility
FUNCTION Sendln
	LPARAMETER lcOutput,llNoOutput
	IF EMPTY(lcOutput)
	  lcOutput=""
	ENDIF  
	RETURN THIS.Write(lcOutput+CRLF,llNoOutput)
ENDFUNC


*********************************************************************
FUNCTION ContentTypeHeader(lvContentType, tlNoOutput)
*****************************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::ContenttypeHeader

*:Description:
Adds a Conent Type header to a request. Use this method to create a default
header or one of the common defaults. For more complex header use the
wwHTTPHeader object instead.

<<H3>>What's a content type?<</H3>>
Web requests require an HTTP header in order to let the browser know how to
display the dynamically generated page. The header looks something like
this:
<<pre>>HTTP/1.0 200 OK
Content-type: text/html

<HTML>
  ...HTML content here.
</HTML>
<</pre>>   
In the above example the Content Type line plus a blank line is the actual
text that makes up the Content type header.

This method adds this ContentType header to a request. This method is also
called internally by various other methods that manipulate the HTTP header.
HTMLHeader() and any full page generation methods such as ExpandTemplate(),
ExpandScript(), ErrorMsg() and StandardPage() pass forward their lvHeader
parameter to this method.

*:Parameters:
<<b>>lcContentType<</b>>
For backward compatibility you can also call this method with a text
parameterCGI requests require a Content Type header which usually looks
like this in the generated document:

<<blockquote>><<b>>Common types are:<</b>>
"text/html"           - Default
"text/xml"            - XML
"text/plain"          - Text data
"Force Reload"         - Force browser to always reload page
"none"                - No header is sent - your code has to set it up
<</blockquote>>

<<b>>oHTTPHeader<</b>>
A preconfigured wwHTTPHeader object that was previously set up and
configured.

<<b>>llNoOutput<</b>>
Output to string and not to HTTP stream.

*:Example:
**** Simple Content Type Assignment on XML data

lcXML = oXML.CursorToXML()

Response.ContentType = "text/xml"
Response.Write(lcXML)
RETURN

**** HTTP Header object ****

lcId=Request.GetCookie("WWUSERID")

*** Create Standard Header - here to add an HTTP Cookie
loHeader=CREATEOBJECT("wwHTTPHeader")
loHeader.DefaultHeader()

*** If not Found
IF EMPTY(lcId)
   *** Create the cookie
   lcId=SYS(3)
   loHeader.AddCookie("WWUSERID",lcId,"/wconnect")
ENDIF

*** Set the Content Type Header
Response.ContentTypeHeader(loHeader)

*** Alternately you can also pass the header to another method
* Response.HTMLHeader("Cookie Test","Cookie Test Page",,loHeader)

*** Followed by regular HTML text (any wwResponse methods valid)
Response.Write("<HTML><BODY>")
Response.Write("Cookie Value (wwUserId):  <b>" +lcId +"</b><p> ")
Response.Write("</BODY></HTML>")

RETURN

*:SeeAlso:
Class wwResponse
Class wwHTTPHeader
wwResponse::expandtemplate
wwResponse::expandscript
wwResponse::htmlheader

*:HelpId:
1067
*:ENDHELP
#ENDIF
*********************************************************************
LOCAL loHeader, lcType, lcOutput

lcType=VARTYPE(lvContentType)

DO CASE
CASE lcType="O"
   *** If we didn't pass an HTML object explicitly
   *** the string needs to be retrieved. Otherwise
   *** Output already went to the HTML object
     
   IF !lvContentType.lPassedHTMLObject
     *** If the AutoSessionCookie is set pass it to the header for completion
     IF !EMPTY(this.cAutoSessionCookie)
         lvContentType.oHTML.cAutoSessionCookiename = this.cAutoSessionCookieName
         lvContentType.oHTML.cAutoSessionCookie = this.cAutoSessionCookie
         lvContentType.oHTML.lAutoSessionCookiePersist = this.lAutoSessionCookiePersist
     ENDIF

     RETURN THIS.Write(lvContentType.GetOutput(),tlNoOutput)
   ELSE
      lvContentType.CompleteHeader()
   ENDIF
   RETURN ""
CASE lcType="C"
   lvContentType = lower(lvContentType)
   IF lvContentType="none" OR EMPTY(lvContentType)
      RETURN ""
   ENDIF

   loHeader = CREATEOBJECT([WWC_HTTPHEADER],this)

   DO CASE 
   CASE lvContentType="force reload"
      loHeader.AddForceReload()
   CASE lvContentType == "cache"
   	  loHeader.AddCacheHeader(lcType)
   OTHERWISE
      loHeader.SetProtocol()
      loHeader.SetContentType(lvContentType)
   ENDCASE   

   *** CompleteHeader adds the required blank line to the header
   loHeader.CompleteHeader()
     
   RETURN ""
OTHERWISE
   RETURN ""
ENDCASE

*** This should never fire
RETURN THIS.Write(loHeader.GetOutput(),tlNoOutput)
ENDFUNC
* EOF wwResponse::ContenttypeHeader



*********************************************************************
FUNCTION WriteMemo(lcText, llNoOutput)
**************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::WriteMemo

*:Description:
Writes memo fields to output. Formats carriage returns to <p> and <br> as
appropriate.

*:Parameters:
<<b>>lcText<</b>>
The text to format. All carriage returns are stripped and replaced.

<<b>>llNoOutput<</b>>
When set to .T. output is not sent to file, instead returning the result as
a string.

*:Returns:
"" if sending to file and the output text if lNoOuput is .T.

*:ENDHELP
#ENDIF
*********************************************************************
LOCAL lcOutput
lcOutput=STRTRAN(lcText,CHR(13)+CHR(10),CHR(13) )
lcOutput=STRTRAN(lcOutput,CHR(13)+CHR(13),"<p>")
lcOutput=STRTRAN(lcOutput,CHR(13),"<br>")
RETURN THIS.Write(@lcOutput,llNoOutput)
ENDFUNC
* EOF wwResponse::WriteMemo



********************************************************************************
FUNCTION ExpandTemplate(tcPageName, tcContentType, tlTemplateString, tlNoOutput)
********************************************************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::ExpandTemplate

*:Description:
The ExpandTemplate method is used to expand template pages that contain
FoxPro expressions using Active Server like syntax. The method generates a
fully self contained HTML page/HTTP output which includes an HTTP header.

The template syntax allowed is simple and looks as follows:

<<pre>><%= Version() %>
<%= Table.FieldName %>
<%= MyUDF() %>
<%= PrivateVar %>
<%= Class.Property %><</pre>>

or

<<pre>><%
Code Block (any valid procedural FoxPro code)
%><</pre>>

Expressions are expanded prior to sending the document back to the client,
so expressions are valid anywhere inside of the HTML document including in
HTML field values and HREF links etc.

*:Parameters:
<<b>>lcPageName<</b>>
Fully qualified filename of the template to expand from disk.
Optionally, this may be a string containing the actual script if the
llTemplateString parameter is set to .T.

<<b>>lvContentType<</b>>
<<i>>Optional<</i>> - Either an wwHTTPHeader object or content type string.
See <<%= TopicLink("wwHTTPHeader class","Class wwHTTPHeader") %>> for info.

<<i>>llTemplateString<</i>>
<<i>>Optional<</i>> - If passed .T. it indicates that lcPageName was passed
as the actual template string, rather than the filename.

llNoOutput
<<i>>Optional<</i>> - if .T. output is returned to string and no HTTP
stream output is created

*:Returns:
"" or HTML string if llNoOutput is .T.

*:Example:
Response.ExpandTemplate(THIS.cHTMLPagePath + "node.wc")

*:Remarks:
Since embedded code blocks (ie. more than one line of code using <% %>) are
dynamically evaluated through macro expansion you'll want to keep the use
of functions to a minimum for speed reasons. If you use excessive functions
in your pages I would highly recommend you build a custom Processing
routine as a UDF instead of building the code into an HTML  page. Custom
code is much easier to debug and maintain and also runs a lot faster since
no on the fly evaluation takes place.
#ENDIF
*********************************************************************
LOCAL lcOutput, lcOldAlias, lnHandle, loEval

IF EMPTY(tcPageName)
   IF TYPE("Request") = "O"
      *** Default to Request.GetPhysicalPath
      tcPageName = Request.GetPhysicalPath() 
   ELSE
      RETURN ""
   ENDIF
ENDIF

*** Add a ContentTypeHeader to output first
THIS.ContentType = tcContentType

lcOutput = ""

IF !tlTemplateString
   *** Read HTML from a disk file
   #IF WWC_CACHE_TEMPLATES > 0
	   lcOutput = CacheFile(tcPageName,WWC_CACHE_TEMPLATES)
	   IF !EMPTY(lcOutput)
	     loEval = CREATE([WWC_wwEval])
	     RETURN THIS.Write(loEval.MergeText(@lcOutput),tlNoOutput)
	   ELSE
	     RETURN THIS.Write(lcOutput+[<h2>Can't find or open page ]+tcPagename+[</h2>],;
	                       tlNoOutput)
	   ENDIF
   #ELSE
	   *** Make sure file exists and can be opened
	   lnHandle=FOPEN(tcPageName,0)
	   IF lnHandle#-1
	     lnSize = FSEEK(lnHandle,0,2)
	     FSEEK(lnHandle,0,0)
	     lcOutput=FREAD(lnHandle,lnSize)
	     =FCLOSE(lnHandle)
	     loEval = CREATE([WWC_wwEval])
	     RETURN THIS.Write(loEval.MergeText(@lcOutput),tlNoOutput)
	   ELSE
	     RETURN THIS.Write(lcOutput+[<h2>Can't find or open page ]+tcPagename+[</h2>],;
	                       tlNoOutput)
	   ENDIF
   #ENDIF
ENDIF 

loEval = CREATEOBJECT("wwEval")
RETURN THIS.Write(loEval.MergeText(@tcPageName),tlNoOutput)
ENDFUNC
* EOF wwResponse::ExpandTemplate


************************************************************************
* wwPageResponse ::  ExpandScript
****************************************
***  Function: Renders a fully self contained page including HTTP header
***    Assume: 
***      Pass:  tcPageName  -  Physical path to the page
***             tnMode      -  1 - Dynamic 2 - Precompiled 3 - ExecScript
***             ContentType -  not recommended - set from script Page
***    Return:
************************************************************************
FUNCTION ExpandScript(tcPageName,tnMode,tvContentType, NotUsed, NotUsed)
LOCAL lcOutput, loScript, llIsServer

IF lower([WWC_SCRIPT_PROCESSOR]) = "wwvfpscript"
   this.ExpandScriptVfpScript(tcPagename,tnMode,tvContentType,NotUsed,NotUsed)
   RETURN
ENDIF

IF EMPTY(tcPageName)
   tcPageName = Request.GetPhysicalPath()
ENDIF

llIsServer = .F.
IF EMPTY(tnMode) 
   IF VARTYPE(Server) = "O"
	   tnMode = Server.nScriptMode
	   llIsServer = .T.
   ELSE   	   	
   	   tnMode = 1
   ENDIF
ENDIF   

*** Don't write a header - let wwScripting do it
this.ContentTypeHeader("NONE")

*** New precompiled script code base
LOCAL loScript as wwScripting, loOldResponse

loScript = CREATEOBJECT("wwScripting")
loScript.cScriptResponseClass = "wwScriptingHttpResponse"
loScript.lNoVersionCheck = .F.
loScript.lEditErrors = .F.

*** Keep reference to the 'real' Response object

*** Now override the Response object so we can apply headers and cookies
PRIVATE Response
Response = loScript.CreateResponse()
Response.cStyleSheet = this.cStyleSheet

#IF .T.
	*** WWRESPONSE SPECIFIC CODE ***
	*** Pick up the Session Cookie
	IF !EMPTY(this.cAutoSessionCookie)
		Response.AddCookie(this.cAutoSessionCookieName,this.cAutoSessionCookie,"/",;
		                   IIF(this.lAutoSessionCookiePersist,"NEVER",""))
	ENDIF
	IF VARTYPE(tvContentType) != "L"
	    Response.ContentTypeHeader( tvContentType )
	ENDIF
#ELSE
	*** WWAPGERESPONSE SPECIFIC CODE
	IF VARTYPE(tvContentType) != "L"
	    Response.ContentTypeHeader( tvContentType )
	ELSE
		*** Copy headers and cookies
		FOR lnX = 1 TO THIS.Headers.Count
			Response.AppendHeader(this.Headers.GetKey(lnX),THIS.Headers.aItems[lnX,2])
		ENDFOR
		FOR lnX = 1 TO THIS.Cookies.Count
			Response.AppendHeader("Set-Cookie",this.Cookies.aItems[lnX,2])
		ENDFOR
	ENDIF
#ENDIF

IF llIsServer AND Server.lDebugMode
	loScript.lShowFullErrorInfo = .T.
	*loScript.lEditErrors = .T.
	*loScript.lStopOnError = .T.
ELSE
	loScript.lShowFullErrorInfo = .F.
ENDIF

DO CASE
    *** Execute only the FXP file - no version check no file check
    CASE tnMode = 2
    	 *** Just run the script code without compiling or checking	
         loScript.lNoVersionCheck = .T.
         lcOutput = loScript.RenderAspScript( tcPageName)

	*** Run with ExecScript
	CASE tnMode = 3
		lcOutput = loScript.ExecScript(tcPageName)
    
    *** Create PRG and FXP files if version has changed
 	CASE tnMode = 1
        IF llIsServer AND Server.lDebugmode
			loScript.lSaveVfpSourceCode = .t.
		ENDIF
		lcOutput = loScript.RenderAspScript( tcPageName)
ENDCASE

THIS.Write( lcOutput )

ENDFUNC
* wwPageResponse :: ExpandScript


*************************************************************************************
FUNCTION ExpandScriptVfpScript(tcPageName, tnMode, tvContentType, tlTemplateString,llNoOutput)
*************************************************************************************
LOCAL lcOutput, lnHandle, oScript

tcPageName=IIF(EMPTY(tcPageName),"",tcPageName)
tnMode = IIF(EMPTY(tnMode),3,tnMode)

*** Add a ContentTypeHeader to output first
THIS.ContentTypeHeader(tvContentType)

lcOutput = ""

*** WCS - Script Text   WCX - Compiled   WCT - Intermediate
IF llNoOutput
   loResponse = CREATEOBJECT([WWC_RESPONSESTRING])
ELSE
   loResponse = THIS
ENDIF

oScript = CREATE([WWC_WWVFPSCRIPT],IIF(tlTemplateString,.f.,tcPageName),loResponse)
oScript.lAlwaysUnloadScript = .T.

*** Using CodeBlock
IF tnMode = 3
    IF tlTemplateString
      *** Code was passed
      lcCode = oScript.ConvertPage(tcPageName,.T.)
    ELSE
      *** Page name from disk was passed
      lcCode = oScript.ConvertPage(File2Var(oScript.cFileName),.T.)
    ENDIF
    
    oScript.RenderPageFromVar(lcCode)

    IF llNoOutput
       RETURN loResponse.GetOutput()
    ENDIF
    
    RETURN
ENDIF

*** Compiled FXP files
IF tnMode = 2
   oScript.RenderPage()
ENDIF

*** VFP Devmode
IF tnMode = 1
   oScript.ConvertPage()
   oScript.RenderPage()
ENDIF

IF llNoOutput
    RETURN loResponse.GetOutput()
ENDIF

RETURN 
ENDFUNC
* EOF wwResponse::ExpandScriptVfpScript

*****************************************************************************
FUNCTION ShowCursor(lvheader, lctitle, llsumnumbers, llNoOutput, lcTableTags)
*****************************************************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::ShowCursor

*:Description:
This method allows easy display of an entire table, simply by having a
table or cursor selected and calling this method. You can optionally pass
an array of headers as well as a title and the option to automatically sum
all numeric fields.


*:Parameters:
<<b>>@aHeaders<</b>>
An array that should contain as many text headers as they are columns in
the table/cursor to display. If this parameter is not passed the field
names are used as column headers.The header names may be followed by a
colon followed by a number indicating the width of  the header to override
the field width which is used by default.

<<b>>Ctitle<</b>>
Title text to display above the headers.

<<b>>lSumNumbers<</b>>
Flag that allows automatic summing of all numeric fields in the table to
display. The total is displayed at the bottom of the display below the
appropriate numeric fields.

<<b>>LNoOutput<</b>>
When set to .T. output is not sent to file, instead returning the result as
a string.

<<b>>cTableTags<</b>>
Allows adding additional table tags to the table display to control the
appearance of the HTML table. For example, you could pass "WIDTH=100%
BORDER=5" to force the table to be full size. The default value is
"WIDTH=90%".


*:Example:
SELECT company, lname ;
   FROM TT_Cust ;
   INTO CURSOR Tquery

*** Basic
oHTML.ShowCursor()

*** Using custom headers
DIMENSION laHeader[2]
laHeader[1]="Company"
laHeader[2]="Last Name"

oHTML.ShowCursor(@laHeaders,"Client List")

*:Remarks:
By default an HTML table is used for output unless output size exceeds
MAX_TABLE_CELLS (in WCONNECT.H) . When this number is exceeded ShowCursor
reverts to a <pre> list display which can render much faster. The default
size for MAX_TABLE_CELLS is 4000 cells.

This is a simple high level method. If you want more control please use the
<<%= TopicLink("wwShowCursor","wwShowCursor") %>> class.

For better performance you should hand-code your tables with the Write()
method. Hand coding can cut request times for large table requests by more
than half.

*:ENDHELP
#ENDIF
*********************************************************************
LOCAL lcheader, lnX, latotals, lcOutput, lnSizeLoc, lnSize, lvValue

IF EMPTY(ALIAS())
   RETURN ""
ENDIF

lcOutput=""
lnfields=AFIELDS(lafields)
lnreccount=RECCOUNT()

*** Keep track of numeric totals
IF llsumnumbers
   DIMENSION latotals[1,lnFields]
   latotals=0
ENDIF

lctitle=IIF(TYPE("lcTitle")="C",lctitle,"")


IF !llNoOutput
  *** If we're not returning a string send output directly to output source
  loShowCursor=CREATE("wwShowCursor",THIS)
ELSE
  *** Otherwise build string internally using wwShowCursor
  loShowCursor=CREATE("wwShowCursor")
ENDIF
    
loShowCursor.cTableTitle=lcTitle
loShowCursor.lSumNumerics=llSumnumbers
loShowCursor.lAlternateRows = .T.
IF !EMPTY(lcTableTags)
   loShowCursor.cExtraTableTags=lcTableTags
ENDIF

IF TYPE("lvHeader[1]")#"U"
   *** Build a custom header based on the array of header strings passed
   loShowCursor.BuildFieldListHeader(@lvHeader)
ENDIF   

loShowCursor.ShowCursor()

IF llNoOutput
  RETURN loShowCursor.GetOutput()
ENDIF

*** Don't need to '.Write' output since we used HTML object for output
RETURN ""
ENDFUNC
* EOF wwResponse::ShowCursor



***************************************************************************
FUNCTION NoOutput(llNoOutput)
*****************************
THIS.lNoOutput = .T.
ENDFUNC

***************************************************************************
FUNCTION End()
**************
THIS.lNoOutput = .T.
ENDFUNC

***********************************************************************************
FUNCTION StandardPage(lcHeader, lcBody, lvHeader,lnRefresh,lcRefreshUrl,llNoOutput)
***********************************************************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::StandardPage

*:Description:
Creates a standalone HTML page. The page is a fully self contained page
that looks like this by default:

<<img src="IMAGES\MISC\RESPONSESTANDARDPAGE.GIF">>

You can customize this look by subclassing this method. However, it's
recommended that you use <<%=
TopicLink("wwProcess::StandardPage","wwProcess::StandardPage") %>> to
subclass since you can provide application specific subclassing at that
level more easily.

*:Parameters:
<<b>>lcHeader<</b>>
The header of the message. This is bolder at the top of the page and also
reflects in the browser's title bar.

<<b>>lcBody<</b>>
The body of the message. This text can contain plain text or HTML.

<<b>>lvHeader<</b>>
<<i>>Optional<</i>>. The content type or HTTP Header object for this page.
You can create a custom header with the wwHTTPHeader class or pass an HTTP
content type.

<<b>>lnRefresh<</b>>
<<i>>Optional<</i>> - If you would like the page to refresh itself after a
while to go to this or another URL you can specify an interval in seconds.

<<b>>lcRefreshUrl<</b>>
<<i>>Optional<</i>> - Specify the URL that you want to go to when you
refresh the page automatically.

<<b>>llNoOutput<</b>>
Output is returned as string and not written to HTTP stream.

*:Returns:
"" or HTML if llNoOutput is .T.

*:Example:

Response.StandardPage("Welcome","Welcome to the West Wind Web Connection
Demo.","FORCE RELOAD")

*:ENDHELP
#ENDIF

*********************************************************************
LOCAL lcOutput

lcHeader=IIF(!EMPTY(lcHeader),lcHeader,"")
lcBody=IIF(!EMPTY(lcBody),lcBody,"")
lnRefresh = IIF(EMPTY(lnRefresh),0,lnRefresh)
IF lnRefresh > 0
   lcRefreshUrl=IIF(EMPTY(lcRefreshUrl),"",lcRefreshUrl)
ENDIF

loHTML = CREATE([WWC_RESPONSESTRING])

loHTML.ContentType = lvHeader

lcOutput = ;
   	[<table border="0" cellpadding="5" width="100%">] + CRLF +;
   	[  <tr><td align="center" colspan="2" bgcolor="Navy" style="color:cornsilk;font-size:16pt;font-weight:bold">]+ CRLF+;
   	lcHeader +  CRLF +;
   	[  </td></tr>] + CRLF +;
   	[  <tr><td style="font-size:10pt"><br><p>] + CRLF +;
   	lcBody + CRLF +;
   	[  </td></tr>] + CRLF +;
   	[</Table>]
   	
*** HTMLError handles
lcOutput = ;
	[<html><head>] + CRLF +;
	[<title>] + lcHeader + [</title>] + CRLF +;
	IIF(lnRefresh>0,[<META HTTP-EQUIV="Refresh" CONTENT="]+TRANS(lnRefresh)+ [; URL=]+lcRefreshUrl + [">],[]) + CRLF +;
	[</head>] + CRLF +;
	[<body color="#FFFFFF" style="font:normal normal 10pt Verdana">] + CRLF  + ;
    lcOutput
 
loHTML.Write(lcOutput)

*** Close down the doc and shut off further output
loHTML.HTMLFooter()
     
RETURN THIS.Write(loHTML.GetOutput(),llNoOutput)
ENDFUNC
* EOF wwResponse::ErrorMsg


************************************************************************
* wwResponse :: DownloadFile
****************************************
***  Function: Downloads a file to the client using a FileOpen dialog
***    Assume:
***      Pass: lcFilename - the file to send
***            lvHeader   - wwHTTPHeader object 
***                         OR content type string (application/msword)
***            lcFileDisplayName - Name of the file to display to the user
***                                should be only a filename - no paths
************************************************************************
FUNCTION DownloadFile(lcFileName, lvHeader, lcFileDisplayName)
LOCAL loHeader, lnSize

IF !FILE(lcFileName)
   loHeader = CREATEOBJECT("wwHttpHeader")
   loHeader.SetProtocol("HTTP/1.1 404 Not Found")
   Response.ContentType = loHeader
   Response.Write("<html><body style='font-family:Verdana,Arial;font-size:10pt'><b style='color:DarkRed'>File not found</b><p>The file you requested on the server was not found.</body></html>")
   RETURN
ENDIF
   
IF VARTYPE(lvHeader) # "O"
   lnSize = FileSize(lcFileName)
   IF EMPTY(lcFileDisplayName)
      lcFileDisplayName = JUSTFNAME(lcFileName)
   ENDIF

   loHeader = CREATEOBJECT("wwHttpHeader")
   loHeader.FileDownloadHeader(lcFileDisplayName,lvHeader,lnSize)
ELSE
   *** It's a header object
   loHeader = lvHeader   
ENDIF

this.TransmitFile(lcFileName,loHeader)
ENDFUNC
*  wwResponse :: DownloadFile

************************************************************************
* wwResponse :: TransmitFile
****************************************
***  Function: Downloads a file to the client. The file is downloaded
***            directly from disk and not converted to a string.
***    Assume:
***      Pass: lcFilename - the file to send
***            lvHeader   - wwHTTPHeader object 
***                         OR content type string (application/msword)
***                         (optional) - if not provided a download dialog is provided
************************************************************************
FUNCTION TransmitFile(lcFileName, lvHeader)
LOCAL loHeader, lnSize

IF !FILE(lcFileName)
   RETURN .f.
ENDIF

THIS.Clear()

IF VARTYPE(lvHeader) # "O"
   *** Must send a content size so browser can show
   *** download dialog
   lnSize = FileSize(lcFileName)

   loHeader = CREATEOBJECT("wwHttpHeader")
   loHeader.SetProtocol()
   IF !EMPTY(lvHeader)
      loHeader.SetContentType(lvHeader)
   ELSE
      loHeader.SetContentType("application/octet-stream")
   ENDIF
   loHeader.AddHeader("Content-Length",TRANSFORM(lnSize))
ELSE
   *** It's a header object
   loHeader = lvHeader   
ENDIF

*** Clear the Response first
this.Clear()

this.ContentType = loHeader
this.FastWrite("WC_TRANSMITFILE: " + lcFileName + CRLF)
ENDFUNC
*  wwResponse :: DownloadFile



*-- Encloses text with a tag supplied. Example: "h3","This is a headline. Works only with tags that have the same start and end tags
FUNCTION tagtext
	LPARAMETER lcTag, lcText, llNoOutput
	RETURN THIS.Write("<" + lcTag + ">"+lcText+"</"+lcTag+">",llNoOutput)
ENDFUNC

*********************************************************************
FUNCTION Authenticate(lcRealm, lcErrorMsg, llNoOutput)
******************************************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::Authenticate

*:Description:
This method is used to perform a request for Web server Basic
Authentication to occur. When this method is called the browser login
dialog box is popped up for the user to type in a username and password.
The password is then validated by the Web server typically against the NT
(or Windows) user database. The exact validation varies by Web server - IIS
uses the NT User database on the server.

*:Parameters:
<<b>>lcRealm<</b>>
The domain name or IP address that is authenticated. This is basically the
name of the domain that displays on the authentication dialog that the
browser pops up.

<<b>>tcErrorMsg<</b>>
The error message HTML that you want to display if an error occurs.

<<b>>tlNoOutput<</b>>
Standard NoOutput flag to return the result as a string.

*:Remarks:
In order for an authentication request to succeed on the server Basic
Authentication must be enabled on the server.

Note: Basic Authentication is a non-secure protocol that sits on top of
HTTP. Passwords are passed as clear text (although encoded with a simple,
easily breakable hash algorithm) and can be easily hijacked with a network
sniffer. If you're worried about security make sure that your
authentication request runs over SSL/HTTPS - when you do the entire request
info is encrypted.

*:SeeAlso:
Class wwResponse
wwRequest::GetAuthenticatedUser

*:Keywords:
Authentication
Security
Login
Basic Authentication

*:HelpId:
1075
*:ENDHELP
#ENDIF
*********************************************************************
LOCAL loHeader, lcOutput
loHeader=CREATE([WWC_HTTPHeader])
loHeader.Authenticate(lcRealm, lcErrorMsg)
THIS.Clear()
lcOutput = THIS.Write(loHeader.GetOutput(),llNoOutput)
THIS.lNoOutput = .T.
RETURN lcOutput
ENDFUNC


FUNCTION BasicAuthentication(lcRealm,lcErrorMsg,llNoOutput)
RETURN this.Authenticate(lcRealm,lcErrorMsg,llNoOutput)

*********************************************************************
FUNCTION Redirect(tcUrl,tlNoOutput)
***********************************
#IF .F.
*:Help Documentation
*:Topic:
wwResponse::Redirect

*:Description:
HTTP Redirection allows you redirect the current request to another URL. A
common scenario is for login operations where the user is trying to access
functionality before he's logged in. When the request comes in you can
redirect the user to the Login page first.

Redirection is an HTTP feature that works through the HTTP header and
requires that all existing output be discarded first.

Redirection is also available through the <<%=
TopicLink("wwHTTPHeader::Redirect","wwHTTPHeader::Redirect") %>> method,
which this method calls internally to generate the Redirect header.


*:Parameters:
<<b>>lcUrl<</b>>
The URL to redirect to. Note: this URL must be fully qualified and cannot
be a server relative URL!

<<b>>llNoOutput<</b>>
When set to .T. output is not sent to file, instead returning the result as
a string.

*:Returns:
"" if sending to file and the output text if lNoOuput is .T.

*:Remarks:
Redirection occurs without additional HTTP header directives. So if you
generated a Cookie or Authentication request prior to the Redirection call
those operations will not be submitted to the browser - it's not supported
by the HTTP protocol.

*:ENDHELP
#ENDIF
*********************************************************************
LOCAL loHeader, lcOutput

loHeader=CREATE([WWC_HTTPHEADER])
loHeader.Redirect(tcUrl)

THIS.Clear()
THIS.lNoOutput = .f.

lcOutput =  THIS.Write(loHeader.GetOutput(),tlNoOutput)

*** Prevent any further output
THIS.lNoOutput = .t.

RETURN lcOutput
ENDFUNC
* EOF wwResponse::Redirect

************************************************************************
* wwHTML :: FormHeader
****************************************
***  Function: Writes an HTML Form header (<form ... >)
***    Assume:
***      Pass: 
***    Return: "" or HTML if llNooutput = .T.
************************************************************************
FUNCTION FormHeader
LPARAMETERS lcAction, lcMethod, lcTarget, lcExtraTags, llNoOutput

IF EMPTY(lcMethod)
  lcMethod = "POST"
ENDIF
IF EMPTY(lcExtraTags)
  lcExtraTags = ""
ENDIF

RETURN THIS.Write([<FORM ACTION="] + lcAction + [" METHOD="] +lcMethod + [" ] + IIF(!EMPTY(lcTarget),[ TARGET="] + lcTarget + [" ],[]) + lcExtraTags + [>],llNoOutput)
ENDFUNC
*  wwHTML :: FormHeader

FUNCTION formtextbox
************************************************************************
* wwHTML :: FormTextbox
*********************************
***  Function: Creates a Textbox Object
***      Pass: lcName        -
***            lcValue       -
***            lnWidth       -
***            lnMaxWidth    -
***            lcCustomTags  -
***    Return: Returns "" or output if llNoOutput .t.
************************************************************************
LPARAMETERS lcName, lcValue, lnWidth, lnMaxWidth, ;
            lcCustomTags, llNoOutput

IF EMPTY(lnWidth)
   lnWidth = 20
ENDIF
IF EMPTY(lnMaxWidth)
   lnMaxWidth = 0
ENDIF
IF EMPTY(lcCustomTags)
   lcCustomTags = ""
ENDIF

lcOutput=[<INPUT TYPE="TEXT" NAME="]+lcName+[" VALUE="]+lcValue+["]

IF !EMPTY(lnWidth)
  lcOutput=lcOutput + [ SIZE="]+LTRIM(STR(lnWidth,3))+["]
ENDIF
IF !EMPTY(lnMaxWidth)
  lcOutput=lcOutput + [ MAXLENGTH="]+LTRIM(STR(lnMaxWidth,3))+["]
ENDIF  
IF !EMPTY(lcCustomTags)
  lcOutput=lcOutput + [ ] + lcCustomTags
ENDIF  

RETURN THIS.Write(lcOutput+[>],llNoOutput)
ENDFUNC

*-- Creates an HTML Form TextArea
FUNCTION formtextarea
************************************************************************
* wwHTML :: FormTextArea
*********************************
***  Function: Creates a Textbox Object
***      Pass: lcName   -  Name of field
***            lcValue  -  Default value
***            lnHeight -  Height in rows
***            lnWidth  -  Width in cols
***       lcCustomTags  -  
***           llNoOutput-  
***    Return: "" or output if llNoOutput
************************************************************************
LPARAMETERS lcName, lcValue, lnHeight, lnWidth, ;
            lcCustomTags, llNoOutput

IF EMPTY(lnWidth)
   lnWidth = 20
ENDIF
IF EMPTY(lnHeight)
   lnHeight = 0
ENDIF
IF EMPTY(lcCustomTags)
   lcCustomTags = ""
ENDIF
            
lcOutput=[<TEXTAREA NAME="]+lcName+["]

IF !EMPTY(lnWidth)
  lcOutput=lcOutput + [ COLS="]+LTRIM(STR(lnWidth,3))+["]
ENDIF
IF !EMPTY(lnHeight)
  lcOutput=lcOutput + [ ROWS="]+LTRIM(STR(lnHeight,3))+["]
ENDIF  
IF !EMPTY(lcCustomTags)
  lcOutput=lcOutput + [ ] + lcCustomTags
ENDIF  

RETURN THIS.Write(lcOutput+[>]+lcValue+[</TEXTAREA>],llNoOutput)


FUNCTION formhidden
************************************************************************
* wwHTML :: FormHidden
*********************************
***  Function: Hidden Form Variable
***      Pass:  lcName   -   Form Var Name
***             lcValue  -   Value of the form
***             llNoOutput
************************************************************************
LPARAMETERS lcName, lcValue, llNoOutput
          
RETURN THIS.Write([<INPUT TYPE="HIDDEN" NAME="]+lcName+[" VALUE="]+lcValue+[">],llNoOutput)
ENDFUNC


FUNCTION formcheckbox
************************************************************************
* wwHTML :: FormCheckBox
*********************************
***  Function: Creates an HTML checkbox
***      Pass: lcName     -    Name ID of the control
***            llValue    -    .T. or .F.  checked status
***            lcText     -    Caption
***            lcCustomTags    Any custom tags for the <INPUT> tag
***            llNoOutput 
***    Return: "" or text if llNoOutput
************************************************************************
LPARAMETERS lcName, llValue, lcText, lcCustomTags, llNoOutput

lcCustomTags=IIF(type("lcCustomTags")="C",lcCustomTags,"")
lcText=IIF(type("lcText")="C",lcText,"")

RETURN THIS.Write([<INPUT TYPE="CheckBox"  VALUE="ON" NAME="]+;
                 lcName+["]+IIF(llValue," CHECKED","")+;
                 " "+lcCustomTags+[>] + lcText,llNoOutput)
ENDFUNC


FUNCTION formradio
************************************************************************
* wwHTML :: FormRadio
*********************************
***  Function: Creates an HTML form Radio Button
***    Assume:
***      Pass: lcName   -   NAME= 
***            lcValue  -   VALUE= (selected value if checked)
***           llSelected-   Checked or UnChecked
***        lcCustomTags -   Custom Tags for the Radio tags
***           llNoOuput -  
***    Return: Nothing or output if llNoOutput = .T.
************************************************************************
LPARAMETERS lcName, lcValue, lcText, llSelected, lcCustomTags, llNoOutput

IF EMPTY(lcCustomTags)
   lcCustomTags = ""
ENDIF

RETURN THIS.Write([<INPUT TYPE="Radio" Value="]+lcValue+[" NAME="]+;
                 lcName+["]+IIF(llSelected," CHECKED","")+;
                 " "+lcCustomTags+[> ]+lcText,llNoOutput)
ENDFUNC


FUNCTION formbutton
************************************************************************
* wwHTML :: FormButton
*********************************
***  Function: Creates an HTML Form button
***    Assume:
***      Pass:  lcName    -   Name of the button
***             lcCaption -   Text for button
***             lcType    -   SUBMIT, RESET, BUTTON
***             lnWidth   -   Width of the button in cols
***          lcCustomTags -   llNoOutput
***    Return:
************************************************************************
LPARAMETERS lcName, lcCaption, lcType, lnWidth, lcCustomTags, llNoOutput

lnWidth=IIF(VARTYPE(lnWidth)="N",lnWidth,20)
lcCustomTags=IIF(vartype(lcCustomTags)="C",lcCustomTags,"")
lcType=IIF(vartype(lcType)="C",lcType,"SUBMIT")


lcOutput=[<INPUT TYPE="]+lcType+[" NAME="]+lcName+[" VALUE="]+lcCaption+["]

IF !EMPTY(lnWidth)
  lcOutput=lcOutput + [ SIZE="]+LTRIM(STR(lnWidth,3))+["]
ENDIF
IF !EMPTY(lcCustomTags)
  lcOutput=lcOutput + [ ] + lcCustomTags
ENDIF  

RETURN THIS.Write(lcOutput+[>],llNoOutput)
ENDFUNC

************************************************************************
* wwResponse :: Href
****************************************
***  Function: Creates text for a Hyperlink
***    Assume: 
***      Pass:
***    Return:
************************************************************************
FUNCTION HRef(lcLink,lcText,tlNoOutput)

IF EMPTY(lcText)
   lcText = lcLink
ENDIF

RETURN THIS.Write([<A HREF="]+lcLink+ [">]+lcText+[</A>],tlNoOutput)
ENDFUNC
* EOF wwResponse::HRef



FUNCTION DBFPopup
************************************************************************
* wwHTML :: FormDataList
*********************************
***  Function: Takes the current table and creates an option
***            List from it.
***    Assume: Table must be open and selected
***      Pass: lcFormVarName  -  Variable name created on the HTML
***                              form. Retrieve with oCGI.GetFormVar()
***            lcCharExpression  Expression to display for each
***                              iteration of the SCAN loop that
***                              displays items for each <OPTION>
***            lcDefault      -  Default text to highlight in the
***                              list. Must exist as an expression
***                              from one of the items in the list
***            lcFirstItem    -  Allows adding 1 item to the top of
***                              the list. Useful for leaving a list
***                              blank or having instructions.
***            lnHeight       -  Height of the list (1).
***            llNoOutput     -  If .T. send text to a string
***    Return: nothing or Output String
************************************************************************
LPARAMETERS lcFormVarName, lcCharExpression, lcDefault, ;
            lcFirstItem, lnHeight, llNoOutput, llMultiSelect, lcKey

LOCAL lnX, lcOutput, lcValue, lcKey, lcInsertKey 

lcCharExpression=IIF(vartype(lcCharExpression)="C",lcCharExpression,Field(1))
lnHeight=IIF(vartype(lnHeight)="N",lnHeight,1)
lcDefault=IIF(vartype(lcDefault)="C",lcDefault," xxxx")
lcFirstItem=IIF(vartype(lcFirstItem)="C",lcFirstItem," xxxx")
lcKey=IIF(vartype(lcKey)="C",lcKey,"")

lcOutput=[<SELECT NAME="]+lcFormVarName+[" SIZE="]+ALLTRIM(STR(lnHeight))+["]+;
         IIF(llMultiSelect,[ MULTIPLE],[])+[>]
lnX=0

*** Insert First Item manually if specified separate
IF lcFirstItem # " xxxx"  && AND !EMPTY(lcFirstItem)
   lnX=1
   lcOutput=lcOutput+[<OPTION>]+lcFirstItem+CRLF   
ENDIF

*** Now loop through and create the items for each record
SCAN
  lnX=lnX+1
  
  lcInsertKey=IIF(!EMPTY(lcKey),[ Value ="]+EVALUATE(lcKey)+[" ],[])
  lcValue=EVALUATE(lcCharExpression)

  IF UPPER(lcDefault)=UPPER(TRIM(lcValue))
     lcOutput=lcOutput+[<OPTION SELECTED]+lcInsertKey+[>]+lcValue+CRLF
  ELSE
     lcOutput=lcOutput+[<OPTION ]+lcInsertKey+[>]+lcValue+CRLF
  ENDIF
ENDSCAN  

lcOutput=lcOutput+"</SELECT>"

RETURN THIS.Write(@lcOutput,llNoOutput)
* OptionList


************************************************************************
* wwResponse :: AddCookie
****************************************
***  Function: Adds a single cookie to the response object
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION AddCookie(tcCookie,tcValue,tcPath,tcExpire)

THIS.cAutoSessionCookieName = tcCookie
THIS.cAutoSessionCookie = tcValue
THIS.lAutoSessionCookiePersist = IIF(tcExpire = "NEVER",.t.,.f.)

ENDFUNC
*  wwResponse :: AddCookie


************************************************************************
FUNCTION IEChart
************************************************************************
* wwHTMLActiveX :: IEChart
*********************************
***  Function: Creates an ActiveX Graph object based on the active
***            table. The first two fields are graphed where the first
***            field must contain the description and the second must
***            hold the value.
***    Assume: Table is open and selected.
***      Pass: lcGraphType     -    "BAR", "LINE", "AREA", "PIE"
***            lnDataCols      -    Columns not counting label col
***            lvWidth         -    Number - Fixed Width in pixels
***                                 Char   - Used as is. Use for 100%
***                                 DEFAULT: "100%"
***            lnHeight        -    Height in pixels
***            lcLabels        -    Comma Delimited list of the l
***            llNoOutput      -
***    Return: String of graph object
************************************************************************
LPARAMETERS lcType, lnDataCols, lvWidth, lnHeight, lcLabels, llNoOutput
LOCAL lnX, y, lnReccount, lnfields, lcOutput, lcWidth

lnDataCols=IIF(type("lnDataCols")="N",lnDataCols,1)
lcLabels=IIF(type("lcLabels")="C",lcLabels,"")
lcType=IIF(type("lcType")="C",UPPER(lcType),"")
lvWidth=IIF(type("lvWidth")#"L",lvWidth,"100%")
lnHeight=IIF(type("lnHeight")="N",lnHeight,250)

IF TYPE("lvWidth")="N"
   lcWidth=LTRIM(STR(lvWidth))
ELSE
   lcWidth=lvWidth
ENDIF      

DO CASE
  CASE lcType="BAR"
     lcType="12"
  CASE lcType="LINE"
     lcType="5"
  CASE lcType="AREA"
     lcType="8"
  CASE lcType="PIE"
     lcType="1"
  OTHERWISE
     IF VAL(lcType)=0
        lcType="12"
     ENDIF  
ENDCASE

lnfields=AFIELDS(lafields)
lnReccount=reccount()

lcOutput=""
lcOutput=lcOutput+[<OBJECT]+CRLF+;
                  [	ID="ocxGraph"]+CRLF+;
   				  [    	CLASSID="clsid:FC25B780-75BE-11CF-8B01-444553540000"]+CRLF+;
			      [        CODEBASE="http://activex.microsoft.com/controls/iexplorer/iechart.ocx#Version=4,70,0,1161"]+CRLF+;
				  [    	TYPE="application/x-oleobject"]+CRLF+;
				  [    	WIDTH=]+lcWidth+CRLF+;
				  [    	HEIGHT=]+LTRIM(STR(lnHeight))+[>]+CRLF+CRLF

* +IIF(llLegend,"1","0")
lcOutput=lcOutput+;
[	<PARAM NAME="hgridStyle" VALUE="3">]+CRLF+;
[	<PARAM NAME="vgridStyle" VALUE="0">]+CRLF+;
[	<PARAM NAME="colorscheme" VALUE="0">]+CRLF+;
[	<PARAM NAME="BackStyle" VALUE="1">]+CRLF+;
[	<PARAM NAME="BackColor" VALUE="#ffffCC">]+CRLF+;
[	<PARAM NAME="ForeColor" VALUE="#0000ff">]+CRLF+;
[	<PARAM NAME="Scale" VALUE="100">]+CRLF+CRLF

* [	<PARAM NAME="columns" Value="]+LTRIM(STR(lnDataCols))+[">]+CRLF+CRLF


lcOutput=lcOutput+;
IIF(lcType == "1",;
[	<PARAM NAME="columns" VALUE="]+ltrim(str(lnReccount))+[">],;
[	<PARAM NAME="rows" VALUE="]+ltrim(str(lnReccount))+[">])+CRLF+;
[	<PARAM NAME="ChartType" VALUE="]+lcType+[">]+CRLF

*** Setup the column headers - Single space delimted text string
lcOutput=lcOutput+[        <PARAM NAME="]+IIF(lcType=="1","ColumnNames","RowNames")+[" VALUE="]
SCAN
   lcOutput=lcOutput+CHRTRAN(ALLTRIM(EVAL(laFields[1,1]))," ","_")+ " "
ENDSCAN
lcOutput=TRIM(lcOutput)+[">]+CRLF

IF !EMPTY(lcLabels)
  lcOutput=lcOutput+[        <PARAM NAME="ColumnNames" VALUE="]+lcLabels+[">]+CRLF+;
                    [        <PARAM NAME="DisplayLegend" VALUE="1]+[">]+CRLF
ENDIF  


lnX=0
IF lcType == "1"
  *** Pie Chart - must be treated differently with columns making up the slices
	SCAN
	    lcOutput=lcOutput+'        <PARAM NAME="DATA[0]['+;
	                      LTRIM(STR(lnX))+']" VALUE="'+LTRIM(str(EVAL(laFields[2,1])))+'">'+CRLF


	  lnX=lnX+1  && Inc Row Counter
	ENDSCAN
ELSE
	SCAN
	  FOR y=1 to lnDataCols
	    lcOutput=lcOutput+'        <PARAM NAME="DATA['+LTRIM(STR(lnX))+']['+;
	                      LTRIM(STR(y-1))+']" VALUE="'+LTRIM(str(EVAL(laFields[y+1,1])))+'">'+CRLF
	  ENDFOR && y=1 to lnDataCols


	  lnX=lnX+1  && Inc Row Counter
	ENDSCAN
ENDIF

lcOutput=lcOutput+[This graph can be viewed with ActiveX enabled browsers only...<p>]+;
                  [<A HREF="http://www.microsoft.com/ie/">Download Internet Explorer now!</a>]+CRLF+;
                  [</object>]+CRLF

RETURN THIS.Write(@lcOutput,llNoOutput)
ENDFUNC
* IEGraph


*** ASP Compatibility Function
FUNCTION ContentType_Assign
LPARAMETER lcValue
IF ISNULL(lcValue)
	*** Odd behavior workaround:
	*** VFP assigns NULL to ContentType value
	*** when object is released. To avoid
	*** adding another header we just skip it
	RETURN
ENDIF
IF VARTYPE(lcValue) = "C"
   THIS.ContentType = lcValue
ENDIF
THIS.ContentTypeHeader(lcValue)
RETURN lcValue


ENDDEFINE
*
*-- EndDefine: wwResponse
**************************************************


