Server : Apache/2.4.43 (Win64) OpenSSL/1.1.1g PHP/7.4.6 System : Windows NT USER-PC 6.1 build 7601 (Windows 7 Professional Edition Service Pack 1) AMD64 User : User ( 0) PHP Version : 7.4.6 Disable Function : NONE Directory : C:/Program Files (x86)/Microsoft Office/OFFICE11/FPCLASS/ |
<%BeginASP%> 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 = "<%IDS_DBREGION_ASP_ERROR_NO_MATCH_QUOTE%>" 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 "<%IDS_DBREGION_ASP_ERROR_PARAMETER_DELIM%>" 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 = "<%IDS_DBREGION_ASP_ERROR_MALFORMED_COL_TYPES%>" Err.Description = Err.Description & "<%IDS_DBREGION_ASP_ERROR_READKB%>" 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 = "<%IDS_DBREGION_ASP_ERROR_NO_RESOLVE_PARAMS%>" Err.Description = Err.Description & "<%IDS_DBREGION_ASP_ERROR_READKB%>" 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 Else fp_fError=True Err.Description = <%IDS_DBREGION_ASP_ERROR_OP_NOT_FOUND%> 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 = "<%IDS_DBREGION_ASP_ERROR_CONN_ERR%>" else Err.Description = "<%IDS_DBREGION_ERROR_DEFAULT_MESSAGE%>" 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><%IDS_DBREGION_ASP_ERROR_HEADER%></b><br>" if fp_DEBUG Then if Not fp_fError Then Response.Write "<%IDS_DBREGION_ASP_ERROR_DESCRIPTION%>" & Server.HtmlEncode(Err.Description) & "<br>" Response.Write "<%IDS_DBREGION_ASP_ERROR_NUMBER%>" & Server.HtmlEncode(Err.Number) & " (0x" & Hex(Err.Number) & ")<br>" Response.Write "<%IDS_DBREGION_ASP_ERROR_SOURCE%>" & Server.HtmlEncode(Err.Source) & "<br>" else Response.Write Err.Description end if if fp_bBlankField Then Response.Write "<%IDS_DBREGION_ASP_ERROR_BLANK_FIELD%>" end if else Response.Write "<%IDS_DBREGION_ERROR_DEFAULT_MESSAGE%>" 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 <%EndASP%>