home *** CD-ROM | disk | FTP | other *** search
/ 207.233.110.77 / 207.233.110.77.tar / 207.233.110.77 / vbasic / _fpclass / fpdblib.inc < prev    next >
Text File  |  2001-08-30  |  4KB  |  183 lines
  1. <%
  2.  
  3. Function FP_FieldVal(rs, fldname)
  4.  
  5.     FP_FieldVal = Server.HTMLEncode(FP_Field(rs, fldname))
  6.     if FP_FieldVal = "" then FP_FieldVal = " "
  7.  
  8. End Function
  9.  
  10. Function FP_Field(rs, fldname)
  11.  
  12.     If Not IsEmpty(rs) And Not (rs Is Nothing) and Not IsNull(rs(fldname)) Then 
  13.         Select Case rs(fldname).Type
  14.             Case 128, 204, 205 ' adBinary, adVarBinary, adLongVarBinary
  15.                 FP_Field = "[#BINARY#]"
  16.             Case 201, 203 ' adLongVarChar, adLongVarWChar
  17.                 if rs(fldname).DefinedSize > 255 then
  18.                     ' check for Access hyperlink fields (only absolute http links)
  19.                     fp_strVal = rs(fldname)
  20.                     fp_idxHash1 = InStr(LCase(fp_strVal),"#http://")
  21.                     if fp_idxHash1 > 0 then
  22.                         fp_idxHash2 = InStr(fp_idxHash1+1,fp_strVal,"#")
  23.                         if fp_idxHash2 > 0 then 
  24.                             ' this is an Access hyperlink; extract the URL part 
  25.                             fp_strVal = Mid(fp_strVal,fp_idxHash1+1)
  26.                             if Right(fp_strVal,1) = "#" then
  27.                                 fp_strVal = Left(fp_strVal,Len(fp_strVal)-1)
  28.                             end if
  29.                         end if
  30.                      end if
  31.                      FP_Field = fp_strVal
  32.                 else
  33.                      FP_Field = rs(fldname)
  34.                 end if
  35.             Case Else
  36.                 FP_Field = rs(fldname)
  37.         End Select
  38.     Else
  39.         FP_Field = ""
  40.     End If
  41.  
  42. End Function
  43.  
  44. Function FP_FieldHTML(rs, fldname)
  45.  
  46.     FP_FieldHTML = Server.HTMLEncode(FP_Field(rs, fldname))
  47.  
  48. End Function
  49.  
  50. Function FP_FieldURL(rs, fldname)
  51.  
  52.     FP_FieldURL = Server.URLEncode(FP_Field(rs, fldname))
  53.  
  54. End Function
  55.  
  56. Function FP_FieldLink(rs, fldname)
  57.  
  58.     FP_FieldLink = Replace(FP_Field(rs, fldname), " ", "%20")
  59.  
  60. End Function
  61.  
  62. Sub FP_OpenConnection(oConn, sAttrs, sUID, sPWD, fMSAccessReadOnly)
  63.  
  64.     Dim sTmp
  65.     Dim sConnStr
  66.     Dim fIsAccessDriver
  67.  
  68.     fIsAccessDriver = (InStr(LCase(sAttrs), "microsoft access driver") > 0)
  69.     sConnStr = FP_RemoveDriverWithDSN(sAttrs)
  70.     sTmp = sConnStr
  71.     
  72.     On Error Resume Next
  73.  
  74.     If fMSAccessReadOnly And fIsAccessDriver Then
  75.  
  76.         sTmp = sTmp & ";Exclusive=1;ReadOnly=1"
  77.  
  78.         Err.Clear
  79.         oConn.Open sTmp, sUID, sPWD
  80.         If Err.Description = "" Then Exit Sub
  81.  
  82.     End If
  83.  
  84.     Err.Clear
  85.     oConn.Open sConnStr, sUID, sPWD
  86.  
  87. End Sub
  88.  
  89. Function FP_RemoveDriverWithDSN(sAttrs)
  90.  
  91.     FP_RemoveDriverWithDSN = sAttrs
  92.  
  93.     sDrv = "driver="
  94.     sDSN = "dsn="
  95.     sLC = LCase(sAttrs)
  96.     if InStr(sLC, sDSN) < 1 then exit function
  97.  
  98.     idxFirst = InStr(sLC, sDrv)
  99.     if idxFirst < 1 then exit function
  100.     idxBeg = idxFirst + Len(sDrv)
  101.     if Mid(sLC,idxBeg,1) = "{" then 
  102.         idxEnd = InStr(idxBeg, sLC, "}")
  103.         if idxEnd > 0 and Mid(sLC,idxEnd+1,1) = ";" then 
  104.             idxEnd = idxEnd + 1
  105.         end if
  106.     else
  107.         idxEnd = InStr(idxBeg, sLC, ";")
  108.     end if
  109.     if idxEnd < 1 then idxEnd = Len(sLC)
  110.     
  111.     FP_RemoveDriverWithDSN = Left(sAttrs,idxFirst-1) & Mid(sAttrs,idxEnd+1)
  112.  
  113. End Function
  114.  
  115. Sub FP_OpenRecordset(rs)
  116.     
  117.     On Error Resume Next
  118.     rs.Open
  119.  
  120. End Sub
  121.  
  122. Function FP_ReplaceQuoteChars(sQry)
  123.  
  124.     Dim sIn
  125.     Dim sOut
  126.     Dim idx
  127.  
  128.     sIn = sQry
  129.     sOut = ""
  130.  
  131.     idx = InStr(sIn, "%%")
  132.  
  133.     Do While (idx > 0)
  134.  
  135.         sOut = sOut & Left(sIn, idx - 1)
  136.         sIn = Mid(sIn, idx + 2)
  137.         if (Left(sIn,1) = "%") And (Left(sIn,2) <> "%%") then
  138.             sIn = Mid(sIn, 2)
  139.             sOut = sOut & "%"
  140.         end if
  141.         sOut = sOut & "::"
  142.  
  143.         idx = InStr(sIn, "%%")
  144.         if idx > 0 then
  145.             sOut = sOut & Left(sIn, idx - 1)
  146.             sIn = Mid(sIn, idx + 2)
  147.             sOut = sOut & "::"
  148.             if (Left(sIn,1) = "%") And (Left(sIn,2) <> "%%") then
  149.                 sIn = Mid(sIn, 2)
  150.                 sOut = sOut & "%"
  151.             end if
  152.         end if
  153.         
  154.         idx = InStr(sIn, "%%")
  155.  
  156.     Loop
  157.  
  158.     sOut = sOut & sIn
  159.  
  160.     FP_ReplaceQuoteChars = sOut
  161.  
  162. End Function
  163.  
  164. Sub FP_Close(obj)
  165.  
  166.     On Error Resume Next
  167.  
  168.     obj.Close
  169.  
  170. End Sub
  171.  
  172. Sub FP_SetCursorProperties(rs)
  173.  
  174.     On Error Resume Next
  175.  
  176.     rs.CursorLocation = 3 ' adUseClient
  177.     rs.CursorType = 3 ' adOpenStatic
  178.  
  179. End Sub
  180.  
  181. %>
  182.  
  183.