KGRKJGETMRETU895U-589TY5MIGM5JGB5SDFESFREWTGR54TY
Server : Apache/2.4.62
System : FreeBSD fbsdweb2.web.rcn.net 14.1-RELEASE FreeBSD 14.1-RELEASE releng/14.1-n267679-10e31f0946d8 GENERIC amd64
User : www ( 80)
PHP Version : 8.3.8
Disable Function : NONE
Directory :  /domains/peterbmiller/_fpclass/

Upload File :
current_dir [ Writeable ] document_root [ Writeable ]

 

Current File : /domains/peterbmiller/_fpclass/fpdbrgn1.inc
<%
     
FP_SetLocaleForPage

' determine whether or not to provide navigation controls
if fp_iPageSize > 0 then
	fp_fShowNavbar = True
else
	fp_fShowNavbar = False
end if

fp_sPagePath = Request.ServerVariables("PATH_INFO")
fp_sEnvKey = fp_sPagePath & "#fpdbr_" & fp_iRegion
fp_sFormName = "fpdbr_" & CStr(fp_iRegion)
fp_sFormKey = fp_sFormName & "_PagingMove"

fp_sInputs = fp_sDefault

fp_DEBUG = False

fp_sFirstLabel = "  |<  "
fp_sPrevLabel  = "   <  "
fp_sNextLabel  = "  >   "
fp_sLastLabel  = "  >|  "
fp_sDashLabel  = "  --  "

if not IsEmpty(Request(fp_sFormKey)) then
	fp_sMoveType = Request(fp_sFormKey)
else
    fp_sMoveType = ""
end if

fp_iCurrent=1
fp_fError=False
fp_bBlankField=False
Set fp_dictInputs = Server.CreateObject("Scripting.Dictionary")
Set fp_dictParams = Server.CreateObject("Scripting.Dictionary")
Set fp_dictColTypes = Server.CreateObject("Scripting.Dictionary")
fp_iParam = 1

fp_sQry = FP_ReplaceQuoteChars(fp_sQry)

' replace any input parameters in query string
' there need to be at least 5 more characters in the string for there to be input parameters (::[_a-z]::)
Do While (Not fp_fError) And (fp_iCurrent + 5 < Len(fp_sQry) And Instr(fp_iCurrent, fp_sQry, "::") > 0)
	fp_iMax = Len(fp_sQry) + 1
	fp_iColonStart = Instr(fp_iCurrent, fp_sQry, "::")
	fp_iSQuoteStart = Instr(fp_iCurrent, fp_sQry, "'")
	fp_iDQuoteStart = Instr(fp_iCurrent, fp_sQry, """")
	
	If (fp_iSQuoteStart = 0) then
		fp_iSQuoteStart = fp_iMax
	End If
	If (fp_iDQuoteStart = 0) then
		fp_iDQuoteStart = fp_iMax
	End If
	
	fp_sQuoteDelim = ""
	fp_iQuoteStart = -1
	fp_iQuoteEnd = fp_iMax
	fp_bQuoteFound = false
	If (fp_iColonStart > fp_iSQuoteStart and fp_iDQuoteStart > fp_iSQuoteStart) then 'single quote is first sought for character
		fp_sQuoteDelim = "'"
		fp_iQuoteStart = fp_iSQuoteStart
	elseIf (fp_iColonStart > fp_iDQuoteStart and fp_iSQuoteStart > fp_iDQuoteStart) then 'double quote is first sought for character
		fp_sQuoteDelim = """"
		fp_iQuoteStart = fp_iDQuoteStart
	else
		'The :: comes before any ' or "
	End If

	If(fp_sQuoteDelim <> "") then
		fp_iPotQuoteEnd = fp_iQuoteStart + 1
		Do While (fp_bQuoteFound = false and fp_iPotQuoteEnd < fp_iMax)
			fp_iPotQuoteEnd = Instr(fp_iPotQuoteEnd, fp_sQry, fp_sQuoteDelim)

			If(fp_iPotQuoteEnd = 0) then 
				exit do
			End If

			If(fp_iPotQuoteEnd = fp_iMax - 1) then
				fp_iQuoteEnd = fp_iPotQuoteEnd
				fp_bQuoteFound = true
				exit do
			End If
            
			If(Mid(fp_sQry, fp_iPotQuoteEnd + 1, 1) <> fp_sQuoteDelim) then
				fp_iQuoteEnd = fp_iPotQuoteEnd
				fp_bQuoteFound = true
			else
				fp_iPotQuoteEnd = fp_iPotQuoteEnd + 2
			End If
		Loop
	    
		If(fp_bQuoteFound = false) then
			Err.Description = "Unable to find a matching quote for " & fp_sQuoteDelim & " in the query."
			fp_fError = true
			fp_bSkip = true
		End If
	    
		If(fp_iColonStart > fp_iQuoteEnd) then 'there is no user input in this literal string
			fp_iCurrent = fp_iQuoteEnd + 1
			fp_bSkip = true
		End If
	    
	else
		fp_iQuoteStart = fp_iColonStart
		fp_bQuoteFound = false
	End If
	
	If not fp_bSkip then
		fp_iStart = fp_iColonStart
		' found a opening ::, find the close ::
		fp_iEnd = InStr(fp_iStart + 2, fp_sQry, "::")
	
		If not fp_bQuoteFound then
			fp_iQuoteEnd = fp_iEnd + 1
		End If
		If fp_iEnd = 0 Then
			fp_fError = True
			Response.Write "<B>Database Results Error: mismatched parameter delimiters</B>"
		Else
			fp_sField = Mid(fp_sQry, fp_iStart + 2, fp_iEnd - fp_iStart - 2)
			fp_sValue = Request.Form(fp_sField)
			if len(fp_sValue) = 0 then fp_sValue = Request.QueryString(fp_sField)

			' if the named form field doesn't exist, make a note of it
			If (len(fp_sValue) = 0) Then
				fp_iStartField = InStr(fp_sDefault, fp_sField & "=")
				if fp_iStartField > 0 then
					fp_iStartField = fp_iStartField + len(fp_sField) + 1
					fp_iEndField = InStr(fp_iStartField,fp_sDefault,"&")
					if fp_iEndField > 0 then
						fp_sValue = Mid(fp_sDefault,fp_iStartField,fp_iEndField - fp_iStartField)
					else
						fp_sValue = Mid(fp_sDefault,fp_iStartField)
					end if
				end if
			End If
	
			' remember names and values used in query
			if not fp_dictInputs.Exists(fp_sField) then
				fp_dictInputs.Add fp_sField, fp_sValue
			end if
		
			if (len(fp_sValue) = 0) Then fp_bBlankField = True
			
			fp_iOpEnd = fp_iQuoteStart - 1
		
			Do While (Mid (fp_sQry , fp_iOpEnd , 1) = " ")
				fp_iOpEnd = fp_iOpEnd - 1
			Loop
		
			fp_iFieldEnd = fp_iOpEnd
			If ( Mid(fp_sQry, fp_iOpEnd - 1, 2) = "<=") then
				fp_iFieldEnd = fp_iOpEnd - 2
			ElseIf (Mid(fp_sQry, fp_iOpEnd - 1, 2) = ">=") then
				fp_iFieldEnd = fp_iOpEnd - 2
			ElseIf (Mid(fp_sQry, fp_iOpEnd - 1, 2) = "<>") then
				fp_iFieldEnd = fp_iOpEnd - 2
			ElseIf (UCase(Mid(fp_sQry, fp_iOpEnd - 3, 4)) = "LIKE" ) then
				fp_iFieldEnd = fp_iOpEnd - 4
			ElseIf (Mid(fp_sQry, fp_iOpEnd, 1) = "=") then
				fp_iFieldEnd = fp_iOpEnd - 1
			ElseIf (Mid(fp_sQry, fp_iOpEnd, 1) = "<") then
				fp_iFieldEnd = fp_iOpEnd - 1
			ElseIf (Mid(fp_sQry, fp_iOpEnd, 1) = ">") then
				fp_iFieldEnd = fp_iOpEnd - 1
			End If
		
			If(fp_iFieldEnd <> fp_iOpEnd) Then
				Do While (fp_iFieldEnd) > 0 and (Mid(fp_sQry,fp_iFieldEnd,1) = " ")
					fp_iFieldEnd = fp_iFieldEnd - 1
				Loop
				fp_colNameDelim = ""
			
				If(fp_iFieldEnd) > 0 then
					fp_sTemp = Mid(fp_sQry,fp_iFieldEnd,1)

					If(InStr("])""",fp_sTemp)) then
						If(InStr("]",fp_sTemp)) then
							fp_colNameDelim = ".["
						ElseIf (InStr(")",fp_sTemp)) then
							fp_colNameDelim = ".("
						ElseIf (InStr("""",fp_sTemp)) then
							fp_colNameDelim = "."""
					End If
						'In the End, we ignore the 'quote' character
					fp_iFieldEnd = fp_iFieldEnd - 1
				End If
			End If
			       
			fp_iFieldStart = fp_iFieldEnd
			If (fp_colNameDelim = "") then
				fp_colNameDelim = " (."
			End If
			
			DO while (fp_iFieldStart > 0 and InStr(fp_colNameDelim, Mid(fp_sQry,fp_iFieldStart,1)) = 0) 
			    fp_iFieldStart = fp_iFieldStart - 1
			Loop
			
			fp_iFieldStart = fp_iFieldStart + 1
	
			fp_sColName = Mid(fp_sQry, fp_iFieldStart, fp_iFieldEnd - fp_iFieldStart + 1)
			
			If( "NOT" = UCase(fp_sColName)) then
				fp_iFieldEnd = fp_iFieldStart - 1
				Do While (fp_iFieldEnd) > 0 and (Mid(fp_sQry,fp_iFieldEnd,1) = " ")
				    fp_iFieldEnd = fp_iFieldEnd - 1
				Loop
			
				fp_colNameDelim = ""
				
				If(fp_iFieldEnd) > 0 then
				   fp_sTemp = Mid(fp_sQry,fp_iFieldEnd,1)
	
					If(InStr("])""",fp_sTemp)) then
						If(InStr("]",fp_sTemp)) then
				       		fp_colNameDelim = ".["
						ElseIf (InStr(")",fp_sTemp)) then
							fp_colNameDelim = ".("
						ElseIf (InStr("""",fp_sTemp)) then
							fp_colNameDelim = "."""
						End If
						'In the End, we ignore the 'quote' character
						fp_iFieldEnd = fp_iFieldEnd - 1
					End If
				End If
				       
				fp_iFieldStart = fp_iFieldEnd
				If(fp_colNameDelim = "") Then
					fp_colNameDelim = " (."
				End If
				
				Do while (fp_iFieldStart > 0 and InStr(fp_colNameDelim, Mid(fp_sQry,fp_iFieldStart,1)) = 0) 
					fp_iFieldStart = fp_iFieldStart - 1
				Loop			
				fp_iFieldStart = fp_iFieldStart + 1

				fp_sColName = Mid(fp_sQry, fp_iFieldStart, fp_iFieldEnd - fp_iFieldStart + 1)
			End If

			fp_sColName = Replace(fp_sColName, "[", "")
			fp_sColName = Replace(fp_sColName, "]", "")

			fp_colType = ""
			fp_iStartField = InStr(fp_sColTypes, "&" & fp_sColName & "=")
			If fp_iStartField > 0 Then
				fp_iStartField = fp_iStartField + len(fp_sColName) + 2
				fp_iEndField = InStr(fp_iStartField,fp_sColTypes,"&")
				If fp_iEndField > 0 Then
					fp_colType = Mid(fp_sColTypes,fp_iStartField,fp_iEndField - fp_iStartField)
				else
					Err.Description = "fp_sColTypes appears to be malformed.<br>"
					Err.Description = Err.Description & "This could happen if your DatabaseRegionStart webbot has an empty or missing s-columnnames or s-columntypes attributes.<br>You may need to read Microsoft Knowledge Base Article 817029.<br>"
					fp_fError = true
				End If
			End If

			If(Len(fp_colType) > 0 and IsNumeric(fp_colType)) Then
				fp_dictColTypes.Add fp_iParam, fp_colType
				
				'Remove single quotes around strings
				select case fp_colType
					case 129, 200, 201, 130, 202, 203 ' adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
						If not fp_bQuoteFound and Left(fp_sValue, 1) = "'" or Left(fp_sValue, 1) = """" Then
							fp_sValue = Mid(fp_sValue,2,Len(fp_sValue)-2)		
						End If
					case else
						' do nothing
				End select
                
				If fp_sQuoteDelim =  """"  Then
					fp_sValue = Replace(fp_sValue, """""", """")
				ElseIf fp_sQuoteDelim = "'" Then
					fp_sValue = Replace(fp_sValue, "''", "'")
				End If

				If (fp_bQuoteFound) then
					fp_sLead = Mid(fp_sQry, fp_iQuoteStart + 1, fp_iColonStart - fp_iQuoteStart -1)
					fp_sTail = Mid(fp_sQry, fp_iEnd + 2, fp_iQuoteEnd - fp_iEnd - 2)
					If fp_sQuoteDelim =  """"  Then
						fp_sLead = Replace(fp_sLead, """""", """")
						fp_sTail = Replace(fp_sTail, """""", """")
					ElseIf fp_sQuoteDelim = "'" Then
						fp_sLead = Replace(fp_sLead, "''", "'")
						fp_sTail = Replace(fp_sTail, "''", "'")
					End If
					
					fp_sValue = fp_sLead & fp_sValue & fp_sTail
				End If
		        
				fp_dictParams.Add fp_iParam, fp_sValue
				fp_iParam = fp_iParam + 1
				fp_sValue = "?"	
			else
			' this next finds the named form field value, and substitutes in
			' doubled single-quotes for all single quotes in the literal value
			' so that SQL doesn't get confused by seeing unpaired single-quotes
				Err.Description = "Your page contains a query with user input parameters that could not be resolved.<br>" 
				Err.Description = Err.Description & "This could happen if your DatabaseRegionStart webbot has an empty or missing s-columnnames or s-columntypes attributes.<br>You may need to read Microsoft Knowledge Base Article 817029.<br>"
				fp_fError = True
			End If
			
			If((Len(fp_sQry) - fp_iQuoteEnd) < 1) then
				fp_sQry = Left(fp_sQry, fp_iQuoteStart - 1) & "?"
			else
				fp_sQry = Left(fp_sQry, fp_iQuoteStart - 1) & "?" & Right(fp_sQry, Len(fp_sQry) - fp_iQuoteEnd)
			End If
		ElseIf (LCase(Mid(fp_sQry, fp_iOpEnd - 1, 2)) = "by") then
			fp_iFieldEnd = fp_iOpEnd - 2
			Do While (fp_iFieldEnd) > 0 and (Mid(fp_sQry,fp_iFieldEnd,1) = " ")
				fp_iFieldEnd = fp_iFieldEnd - 1
			Loop

			If (LCase(Mid(fp_sQry, fp_iFieldEnd - 4, 5)) = "order") then
				' only accept column names as parameters
				If(InStr(1, fp_sColTypes, "&" & fp_sValue & "=", 1)) then
					If((Len(fp_sQry) - fp_iQuoteEnd) < 1) then
						fp_sQry = Left(fp_sQry, fp_iQuoteStart - 1) & fp_sValue
					else
						fp_sQry = Left(fp_sQry, fp_iQuoteStart - 1) & fp_sValue & Right(fp_sQry, Len(fp_sQry) - fp_iQuoteEnd)
					End If
				Else
					fp_fError=True
					Err.Description = "The operation failed.  If this continues, please contact your server administrator.<br>"
				End If	
			Else
				fp_fError=True
				Err.Description = "Unable to find operator in query string.  Query string currently is " & fp_sQry
			End If
		Else
			fp_fError=True
			Err.Description = "Unable to find operator in query string.  Query string currently is " & fp_sQry
		End If
		
		' Fixup the new current position to be after the substituted value
		fp_iCurrent = fp_iQuoteStart + 1
	End If
	End If 
	fp_bSkip = false
Loop

' establish connection
If Not fp_fError Then
	if Application(fp_sDataConn & "_ConnectionString") = "" then
		if fp_DEBUG Then
			Err.Description = "The database connection named '" & fp_sDataConn & "' is undefined.<br><br>This problem can occur if:<br>* the connection has been removed from the web<br>* the file 'global.asa' is missing or contains errors<br>* the root folder does not have Scripting permissions enabled<br>* the web is not marked as an Application Root<br>"
		else 
			Err.Description = "The operation failed.  If this continues, please contact your server administrator.<br>"
		end if	
		fp_fError = True
	end if
	if Not fp_fError then
		set fp_conn = Server.CreateObject("ADODB.Connection")
		fp_conn.ConnectionTimeout = Application(fp_sDataConn & "_ConnectionTimeout")
		fp_conn.CommandTimeout = Application(fp_sDataConn & "_CommandTimeout")
		fp_sConn = Application(fp_sDataConn & "_ConnectionString")
		fp_sUid = Application(fp_sDataConn & "_RuntimeUserName")
		fp_sPwd = Application(fp_sDataConn & "_RuntimePassword")
		Err.Clear
		FP_OpenConnection fp_conn, fp_sConn, fp_sUid, fp_sPwd, Not(fp_fCustomQuery)
		if Err.Description <> "" then fp_fError = True
	end if
	if Not fp_fError then
		set fp_cmd = Server.CreateObject("ADODB.Command")
		fp_cmd.CommandText = fp_sQry
		fp_cmd.CommandType = fp_iCommandType
		set fp_cmd.ActiveConnection = fp_conn
		set fp_rs = Server.CreateObject("ADODB.Recordset")
		set fp_rs.Source = fp_cmd
		
		On Error Resume Next
		fp_iTemp = 1
		Do While fp_iTemp < fp_iParam
			fp_colType = fp_dictColTypes.Item(fp_iTemp)
			fp_colValue = fp_dictParams.Item(fp_iTemp)
			
			select case fp_colType 
				case 129, 200, 201, 130, 202, 203 ' adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
					fp_cmd.Parameters.Append = fp_cmd.CreateParameter("Field"&fp_iTemp, fp_colType, 1, Len(fp_colValue) + 1)		
				case else
					fp_cmd.Parameters.Append = fp_cmd.CreateParameter("Field"&fp_iTemp, fp_colType, 1 )		
			end select
			fp_cmd.Parameters("Field"&fp_iTemp).Value = fp_colValue
			fp_iTemp = fp_iTemp + 1
		LOOP
		On Error Goto 0
		
		If fp_iCommandType = 4 Then
			fp_cmd.Parameters.Refresh
			Do Until Len(fp_sInputs) = 0
				fp_iLoc = InStr(fp_sInputs,"=")
				if fp_iLoc = 0 then exit do
				fp_sKey = Left(fp_sInputs,fp_iLoc - 1)
				fp_sInputs = Mid(fp_sInputs,fp_iLoc + 1)
				fp_iLoc = InStr(fp_sInputs,"&")
				if fp_iLoc = 0 then
					fp_sInpVal = fp_sInputs
					fp_sInputs = ""
				else
					fp_sInpVal = Left(fp_sInputs,fp_iLoc - 1)
					fp_sInputs = Mid(fp_sInputs,fp_iLoc + 1)
				end if			
				fp_sVal = Request.Form(fp_sKey)
				if len(fp_sVal) = 0 then fp_sVal = Request.QueryString(fp_sKey)
				if len(fp_sVal) = 0 then fp_sVal = fp_sInpVal
				fp_pType = fp_cmd.Parameters(fp_sKey).Type
				select case fp_pType
					case 129, 200, 201, 130, 202, 203 ' adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
						fp_cmd.Parameters(fp_sKey).Size = Len(fp_sVal) + 1
					case else
						' do nothing
				end select

				' remember names and values used in query
				if not fp_dictInputs.Exists(fp_sKey) then
					fp_dictInputs.Add fp_sKey, fp_sVal
				end if

				fp_cmd.Parameters(fp_sKey) = fp_sVal
			Loop
		End If
		If fp_iMaxRecords <> 0 Then fp_rs.MaxRecords = fp_iMaxRecords

		FP_SetCursorProperties(fp_rs)

		FP_OpenRecordset(fp_rs)
	end if

    if(Err.Description = ""	) then
		' Check for the no-record case
		if fp_rs.State <> 1 then
			fp_fError = True
			Response.Write fp_sNoRecords
		ElseIf fp_rs.EOF And fp_rs.BOF Then
			fp_fError = True
			Response.Write fp_sNoRecords
		end if
    end if
end if

If Err.Description <> "" Then
	if fp_fTableFormat then
		Response.Write "<tr><td colspan=" & fp_iDisplayCols & " color=#000000 bgcolor=#ffff00>"
	end if
	Response.Write "<tt>"
	Response.Write "<b>Database Results Wizard Error</b><br>"
	if fp_DEBUG Then
		if Not fp_fError Then
				Response.Write "<i>Description:</i> " & Server.HtmlEncode(Err.Description) & "<br>"
				Response.Write "<i>Number:</i> " & Server.HtmlEncode(Err.Number) & " (0x" & Hex(Err.Number) & ")<br>"
				Response.Write "<i>Source:</i> " & Server.HtmlEncode(Err.Source) & "<br>"
		else
			Response.Write Err.Description
		end if
		if fp_bBlankField Then
			Response.Write "<br>One or more form fields were empty. You should provide default values for all form fields that are used in the query."
		end if
	else
			Response.Write "The operation failed.  If this continues, please contact your server administrator.<br>"
	end if
	Response.Write "</tt>"
	if fp_fTableFormat then
		Response.Write "</td></tr>"
	end if
	fp_fError = True
end if	



' determine whether or not provider supports Absolute Positioning
if not fp_fError then
	if IsObject(fp_rs) and not(fp_rs.Supports(&H00004000)) then 
		fp_iPageSize = 0
		fp_fShowNavbar = False
	end if
end if

' move to correct position in result set
if not fp_fError then

    if fp_iPageSize > 0 then
		fp_iAbsPage = 1
		fp_sVal = Session(fp_sEnvKey)
		if fp_sVal <> "" then 
			fp_iAbsPage = CInt(fp_sVal)
		end if

		fp_rs.PageSize = fp_iPageSize
		if fp_iAbsPage > fp_rs.PageCount then fp_iAbsPage = fp_rs.PageCount
		fp_rs.AbsolutePage = fp_iAbsPage
		if fp_rs.PageCount = 1 then fp_fShowNavbar = False

		select case fp_sMoveType
			case ""
				' do nothing
			case fp_sFirstLabel
				fp_rs.AbsolutePage = 1
			case fp_sPrevLabel
				if fp_rs.AbsolutePage > 1 then fp_rs.AbsolutePage = fp_rs.AbsolutePage - 1
			case fp_sNextLabel
				if fp_rs.AbsolutePage < fp_rs.PageCount then fp_rs.AbsolutePage = fp_rs.AbsolutePage + 1
			case fp_sLastLabel
				fp_rs.AbsolutePage = fp_rs.PageCount
			case else
				' do nothing
		end select

		fp_iAbsPage = fp_rs.AbsolutePage
		Session(fp_sEnvKey) = fp_iAbsPage
    end if

end if

if fp_fError then fp_fShowNavbar = False

fp_iCount = 0
Do
    if fp_fError then exit do
    if fp_rs.EOF then exit do
    if fp_iPageSize > 0 And fp_iCount >= fp_rs.PageSize then exit do
    if fp_iMaxRecords > 0 And fp_iCount >= fp_iMaxRecords then 
	' MaxRecords didn't work; exit loop
	fp_fShowNavbar = False
	exit do
    end if
%>



Anon7 - 2021