[code]
Private Sub IFcgiApp_ProcessRequest(po_Request As VbFcgiLib.CFcgiRequest, po_Response As VbFcgiLib.CFcgiResponse)
Dim l_StartedBuildAt As Double
Dim ii As Long
Dim lo_Header As vbRichClient5.cStringBuilder
Dim lo_IBuilder As VbFcgiLib.IBuilder
Dim lo_Html As VbFcgiLib.CBuilderHtml
Dim l_Title As String
Dim l_SubTitle As String
Dim l_SubTitleExample As String
Dim l_SubTitleExampleUrl As String
Dim l_VisitCount As Long
Dim l_HttpHost As String
Dim l_TagIndex As Long
On Error GoTo ErrorHandler
' Make sure that FCGI parameters are complete built and the Upstream FCGI object has been set
' otherwise raise fcgierr_NotReadyForResponse
' Just a sanity check - this should never happen
If po_Request.Fcgi.Params.State <> paramstate_Built Then Err.Raise fcgierr_NotReadyForResponse, , "FCGI Parameters incomplete."
l_StartedBuildAt = libRc5Factory.C.HPTimer
Set mo_FcgiParams = po_Request.Fcgi.Params
Set mo_FcgiStdin = po_Request.Fcgi.Stdin
' Initialize the HTML builder/helper
Set lo_Html = po_Response.Builders.Builder(builder_Html)
With lo_Html
.AppendDocType htmldoctype_Html5
.OpenTags "html"
l_TagIndex = .OpenTags("head")
' *** START DEMONSTRATION OF QUERY PARAMETER HANDLING
If po_Request.Http.QueryParameters.Exists("title") Then
l_Title = lo_Html.EncodeEntities(po_Request.Http.QueryParameters("title"))
End If
' *** END DEMONSTRATION OF QUERY PARAMETER HANDLING
If stringIsEmptyOrWhitespaceOnly(l_Title) Then
l_Title = "vbFcgi Demo App"
l_SubTitle = "Pass a ""title"" query to change the title of this page."
l_SubTitleExampleUrl = "http://" & l_HttpHost & po_Request.Fcgi.Params.ValueByEnum(stdparam_ScriptName) & "?title=Greetings from planet earth!"
End If
.AppendWithTag l_Title, "title"
.CloseOpenedTagsToIndex l_TagIndex ' Close <head> tag
' Build BODY
.OpenTags "body"
.AppendWithTag l_Title, "h1"
If Not stringIsEmptyOrWhitespaceOnly(l_SubTitle) Then
.AppendWithTag l_SubTitle, "h2"
l_TagIndex = .OpenTags("p")
.Append "Example: "
.OpenHyperlinkTag l_SubTitleExampleUrl
.Append .EncodeEntities(l_SubTitleExampleUrl)
.CloseOpenedTagsToIndex l_TagIndex ' Close up to H3 tag
End If
l_TagIndex = .OpenTags("p", "b")
.Append "<a href='https://www.github.com/jpbro/VbFcgi'>Learn more about VbFcgi on GitHub.</a>"
.CloseOpenedTagsToIndex l_TagIndex ' Close B and P tags
' *** START DEMONSTRATION OF COOKIES
l_TagIndex = .OpenTagWithAttributes("p", , , "color: orange; font-weight: bold;")
If po_Request.Http.Cookies.Exists("visits") Then
On Error Resume Next
l_VisitCount = po_Request.Http.Cookies.CookieByKey("visits").Value
On Error GoTo ErrorHandler
If l_VisitCount = 0 Then
' Bad cookie value!
.Append "Hey! Have you been mucking about with your cookies?"
Else
' Display number of visits
.Append4 "You have previously visited this page ", l_VisitCount, " time", IIf(l_VisitCount <> 1, "s.", ".")
End If
Else
' First visit
.Append "This is your first visit, pleased to meet you!"
End If
.CloseOpenedTagsToIndex l_TagIndex ' Close P tag
' Increment "Visits" cookie
po_Request.Http.Cookies.AddOrReplaceCookie "visits", l_VisitCount + 1
' *** END DEMONSTRATION OF COOKIES
.Append4 "<p>", "The current date & time on the server is: ", Now, "</p>"
.AppendWithTag "VbFcgi is " & ChrW$(&HAAA&) & ChrW$(&HE01&) & ChrW$(&H671&) & ChrW$(&H188&) & ChrW$(&H47B&) & ChrW$(&H257&) & ChrW$(&HFEC9&) & " capable via UTF-8!", "p"
' Build FCGI Parameters table
.AppendWithTag "FCGI Parameters received from Upstream Webserver:", "h2"
.OpenTags "table"
For ii = 1 To mo_FcgiParams.Count - 1
.OpenTags "tr"
.AppendWithTag mo_FcgiParams.KeyByIndex(ii), "td"
.AppendWithTag mo_FcgiParams.ValueByIndex(ii), "td"
.CloseLastOpenedTag ' Close tr tag
Next ii
.CloseLastOpenedTag ' Close table tag
Reply With Quote