home *** CD-ROM | disk | FTP | other *** search
/ bombers.k12.ar.us / bombers.k12.ar.us.tar / bombers.k12.ar.us / _fpclass / fpdbrgn1.inc < prev    next >
Text File  |  2001-08-10  |  8KB  |  249 lines
  1.  
  2. <%
  3.  
  4. ' determine whether or not to provide navigation controls
  5. if fp_iPageSize > 0 then
  6.     fp_fShowNavbar = True
  7. else
  8.     fp_fShowNavbar = False
  9. end if
  10.  
  11. fp_sPagePath = Request.ServerVariables("PATH_INFO")
  12. fp_sEnvKey = fp_sPagePath & "#fpdbr_" & fp_iRegion
  13. fp_sFormName = "fpdbr_" & CStr(fp_iRegion)
  14. fp_sFormKey = fp_sFormName & "_PagingMove"
  15.  
  16. fp_sInputs = fp_sDefault
  17.  
  18. fp_sFirstLabel = "  |<  "
  19. fp_sPrevLabel  = "   <  "
  20. fp_sNextLabel  = "  >   "
  21. fp_sLastLabel  = "  >|  "
  22. fp_sDashLabel  = "  --  "
  23.  
  24. if not IsEmpty(Request(fp_sFormKey)) then
  25.     fp_sMoveType = Request(fp_sFormKey)
  26. else
  27.     fp_sMoveType = ""
  28. end if
  29.  
  30. fp_iCurrent=1
  31. fp_fError=False
  32. fp_bBlankField=False
  33. Set fp_dictInputs = Server.CreateObject("Scripting.Dictionary")
  34.  
  35. fp_sQry = FP_ReplaceQuoteChars(fp_sQry)
  36.  
  37. ' replace any input parameters in query string
  38. Do While (Not fp_fError) And (InStr(fp_iCurrent, fp_sQry, "::") <> 0)
  39.     ' found a opening quote, find the close quote
  40.     fp_iStart = InStr(fp_iCurrent, fp_sQry, "::")
  41.     fp_iEnd = InStr(fp_iStart + 2, fp_sQry, "::")
  42.     If fp_iEnd = 0 Then
  43.         fp_fError = True
  44.         Response.Write "<B>Database Results Error: mismatched parameter delimiters</B>"
  45.     Else
  46.         fp_sField = Mid(fp_sQry, fp_iStart + 2, fp_iEnd - fp_iStart - 2)
  47.         fp_sValue = Request.Form(fp_sField)
  48.         if len(fp_sValue) = 0 then fp_sValue = Request.QueryString(fp_sField)
  49.  
  50.         ' if the named form field doesn't exist, make a note of it
  51.         If (len(fp_sValue) = 0) Then
  52.             fp_iStartField = InStr(fp_sDefault, fp_sField & "=")
  53.             if fp_iStartField > 0 then
  54.                 fp_iStartField = fp_iStartField + len(fp_sField) + 1
  55.                 fp_iEndField = InStr(fp_iStartField,fp_sDefault,"&")
  56.                 if fp_iEndField > 0 then
  57.                     fp_sValue = Mid(fp_sDefault,fp_iStartField,fp_iEndField - fp_iStartField)
  58.                 else
  59.                     fp_sValue = Mid(fp_sDefault,fp_iStartField)
  60.                 end if
  61.             end if
  62.         End If
  63.  
  64.         ' remember names and values used in query
  65.         if not fp_dictInputs.Exists(fp_sField) then
  66.             fp_dictInputs.Add fp_sField, fp_sValue
  67.         end if
  68.  
  69.         ' this next finds the named form field value, and substitutes in
  70.         ' doubled single-quotes for all single quotes in the literal value
  71.         ' so that SQL doesn't get confused by seeing unpaired single-quotes
  72.         If (Mid(fp_sQry, fp_iStart - 1, 1) = """") Then
  73.             fp_sValue = Replace(fp_sValue, """", """""")
  74.         ElseIf (Mid(fp_sQry, fp_iStart - 1, 1) = "'") Then
  75.             fp_sValue = Replace(fp_sValue, "'", "''")
  76.         End If
  77.  
  78.         If (len(fp_sValue) = 0) Then fp_bBlankField = True
  79.  
  80.         fp_sQry = Left(fp_sQry, fp_iStart - 1) & fp_sValue & Right(fp_sQry, Len(fp_sQry) - fp_iEnd - 1)
  81.         
  82.         ' Fixup the new current position to be after the substituted value
  83.         fp_iCurrent = fp_iStart + Len(fp_sValue)
  84.     End If
  85. Loop
  86.  
  87. ' establish connection
  88. If Not fp_fError Then
  89.     if Application(fp_sDataConn & "_ConnectionString") = "" then
  90.         Err.Description = "The database connection named '" & fp_sDataConn & "' is undefined.<br><br>"
  91.         Err.Description = Err.Description & "This problem can occur if:<br>"
  92.         Err.Description = Err.Description & "* the connection has been removed from the web<br>"
  93.         Err.Description = Err.Description & "* the file 'global.asa' is missing or contains errors<br>"
  94.         Err.Description = Err.Description & "* the root folder does not have Scripting permissions enabled<br>"
  95.         Err.Description = Err.Description & "* the web is not marked as an Application Root<br>"
  96.         fp_fError = True
  97.     end if
  98.     if Not fp_fError then
  99.         set fp_conn = Server.CreateObject("ADODB.Connection")
  100.         fp_conn.ConnectionTimeout = Application(fp_sDataConn & "_ConnectionTimeout")
  101.         fp_conn.CommandTimeout = Application(fp_sDataConn & "_CommandTimeout")
  102.         fp_sConn = Application(fp_sDataConn & "_ConnectionString")
  103.         fp_sUid = Application(fp_sDataConn & "_RuntimeUserName")
  104.         fp_sPwd = Application(fp_sDataConn & "_RuntimePassword")
  105.         Err.Clear
  106.         FP_OpenConnection fp_conn, fp_sConn, fp_sUid, fp_sPwd, Not(fp_fCustomQuery)
  107.         if Err.Description <> "" then fp_fError = True
  108.     end if
  109.     if Not fp_fError then
  110.         set fp_cmd = Server.CreateObject("ADODB.Command")
  111.         fp_cmd.CommandText = fp_sQry
  112.         fp_cmd.CommandType = fp_iCommandType
  113.         set fp_cmd.ActiveConnection = fp_conn
  114.         set fp_rs = Server.CreateObject("ADODB.Recordset")
  115.         set fp_rs.Source = fp_cmd
  116.         If fp_iCommandType = 4 Then
  117.             fp_cmd.Parameters.Refresh
  118.             Do Until Len(fp_sInputs) = 0
  119.                 fp_iLoc = InStr(fp_sInputs,"=")
  120.                 if fp_iLoc = 0 then exit do
  121.                 fp_sKey = Left(fp_sInputs,fp_iLoc - 1)
  122.                 fp_sInputs = Mid(fp_sInputs,fp_iLoc + 1)
  123.                 fp_iLoc = InStr(fp_sInputs,"&")
  124.                 if fp_iLoc = 0 then
  125.                     fp_sInpVal = fp_sInputs
  126.                     fp_sInputs = ""
  127.                 else
  128.                     fp_sInpVal = Left(fp_sInputs,fp_iLoc - 1)
  129.                     fp_sInputs = Mid(fp_sInputs,fp_iLoc + 1)
  130.                 end if            
  131.                 fp_sVal = Request.Form(fp_sKey)
  132.                 if len(fp_sVal) = 0 then fp_sVal = Request.QueryString(fp_sKey)
  133.                 if len(fp_sVal) = 0 then fp_sVal = fp_sInpVal
  134.                 fp_pType = fp_cmd.Parameters(fp_sKey).Type
  135.                 select case fp_pType
  136.                     case 129, 200, 201, 130, 202, 203 ' adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
  137.                         fp_cmd.Parameters(fp_sKey).Size = Len(fp_sVal) + 1
  138.                     case else
  139.                         ' do nothing
  140.                 end select
  141.  
  142.                 ' remember names and values used in query
  143.                 if not fp_dictInputs.Exists(fp_sKey) then
  144.                     fp_dictInputs.Add fp_sKey, fp_sVal
  145.                 end if
  146.  
  147.                 fp_cmd.Parameters(fp_sKey) = fp_sVal
  148.             Loop
  149.         End If
  150.         If fp_iMaxRecords <> 0 Then fp_rs.MaxRecords = fp_iMaxRecords
  151.  
  152.         FP_SetCursorProperties(fp_rs)
  153.  
  154.         FP_OpenRecordset(fp_rs)
  155.     end if
  156.  
  157.     If Err.Description <> "" Then
  158.         if fp_fTableFormat then
  159.             Response.Write "<tr><td colspan=" & fp_iDisplayCols & " color=#000000 bgcolor=#ffff00>"
  160.         end if
  161.         Response.Write "<tt>"
  162.         Response.Write "<b>Database Results Error</b><br>"
  163.         if Not fp_fError then
  164.             Response.Write "<i>Description:</i> " & Err.Description & "<br>"
  165.             Response.Write "<i>Number:</i> " & Err.Number & " (0x" & Hex(Err.Number) & ")<br>"
  166.             Response.Write "<i>Source:</i> " & Err.Source & "<br>"
  167.         else
  168.             Response.Write Err.Description
  169.         end if
  170.         if fp_bBlankField Then
  171.             Response.Write "<br>One or more form fields were empty."
  172.             Response.Write " You should provide default values for all form fields that are used in the query."
  173.         End If
  174.         Response.Write "</tt>"
  175.         if fp_fTableFormat then
  176.             Response.Write "</td></tr>"
  177.         end if
  178.         fp_fError = True
  179.     Else
  180.         ' Check for the no-record case
  181.         if fp_rs.State <> 1 then
  182.             fp_fError = True
  183.             Response.Write fp_sNoRecords
  184.         ElseIf fp_rs.EOF And fp_rs.BOF Then
  185.             fp_fError = True
  186.             Response.Write fp_sNoRecords
  187.         end if
  188.     end if
  189. end if
  190.  
  191. ' determine whether or not provider supports Absolute Positioning
  192. if not fp_fError then
  193.     if IsObject(fp_rs) and not(fp_rs.Supports(&H00004000)) then 
  194.         fp_iPageSize = 0
  195.         fp_fShowNavbar = False
  196.     end if
  197. end if
  198.  
  199. ' move to correct position in result set
  200. if not fp_fError then
  201.  
  202.     if fp_iPageSize > 0 then
  203.         fp_iAbsPage = 1
  204.         fp_sVal = Session(fp_sEnvKey)
  205.         if fp_sVal <> "" then 
  206.             fp_iAbsPage = CInt(fp_sVal)
  207.         end if
  208.  
  209.         fp_rs.PageSize = fp_iPageSize
  210.         if fp_iAbsPage > fp_rs.PageCount then fp_iAbsPage = fp_rs.PageCount
  211.         fp_rs.AbsolutePage = fp_iAbsPage
  212.         if fp_rs.PageCount = 1 then fp_fShowNavbar = False
  213.  
  214.         select case fp_sMoveType
  215.             case ""
  216.                 ' do nothing
  217.             case fp_sFirstLabel
  218.                 fp_rs.AbsolutePage = 1
  219.             case fp_sPrevLabel
  220.                 if fp_rs.AbsolutePage > 1 then fp_rs.AbsolutePage = fp_rs.AbsolutePage - 1
  221.             case fp_sNextLabel
  222.                 if fp_rs.AbsolutePage < fp_rs.PageCount then fp_rs.AbsolutePage = fp_rs.AbsolutePage + 1
  223.             case fp_sLastLabel
  224.                 fp_rs.AbsolutePage = fp_rs.PageCount
  225.             case else
  226.                 ' do nothing
  227.         end select
  228.  
  229.         fp_iAbsPage = fp_rs.AbsolutePage
  230.         Session(fp_sEnvKey) = fp_iAbsPage
  231.     end if
  232.  
  233. end if
  234.  
  235. if fp_fError then fp_fShowNavbar = False
  236.  
  237. fp_iCount = 0
  238. Do
  239.     if fp_fError then exit do
  240.     if fp_rs.EOF then exit do
  241.     if fp_iPageSize > 0 And fp_iCount >= fp_rs.PageSize then exit do
  242.     if fp_iMaxRecords > 0 And fp_iCount >= fp_iMaxRecords then 
  243.     ' MaxRecords didn't work; exit loop
  244.     fp_fShowNavbar = False
  245.     exit do
  246.     end if
  247. %>
  248.  
  249.