Clickx 75/Clickx 75.iso/software/expressionweb/expressionwebv3/ExpressionWeb_en.exe/Setup/WeNoLoc.cab/xweb.FPCLASS.FPDBRGN1.INC

Text File | 2009-06-09 | 16.7 KB | 532 lines

<%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
        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 = "<%IDS_DBREGION_ERROR_DEFAULT_MESSAGE%>"
                End If
            Else
                fp_fError=True
                Err.Description = <%IDS_DBREGION_ASP_ERROR_OP_NOT_FOUND%>
            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
        fp_cmd.CommandTimeout = fp_conn.CommandTimeout
        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%>