Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
ASP and Display image
Message
De
15/07/2000 20:40:26
 
 
À
15/07/2000 20:27:41
Information générale
Forum:
Visual FoxPro
Catégorie:
Applications Internet
Divers
Thread ID:
00392957
Message ID:
00392966
Vues:
8
I think it's a little dificult to do that because i'm trying to do that with FrontPage 2000, and it creates several .inc files with the code.

But i think the problem is in that .inc file,

***************************************************
Function FP_FieldVal(rs, fldname)

FP_FieldVal = Server.HTMLEncode(FP_Field(rs, fldname))
if FP_FieldVal = "" then FP_FieldVal = " "

End Function

**** Here in that function.... *****************
Function FP_Field(rs, fldname)

If Not IsEmpty(rs) And Not (rs Is Nothing) and Not IsNull(rs(fldname)) Then
Select Case rs(fldname).Type
Case 128, 204, 205 ' adBinary, adVarBinary, adLongVarBinary
FP_Field = "[#BINARY#]"
Case 201, 203 ' adLongVarChar, adLongVarWChar
if rs(fldname).DefinedSize > 255 then
' check for Access hyperlink fields (only absolute http links)
fp_strVal = rs(fldname)
fp_idxHash1 = InStr(LCase(fp_strVal),"#http://")
if fp_idxHash1 > 0 then
fp_idxHash2 = InStr(fp_idxHash1+1,fp_strVal,"#")
if fp_idxHash2 > 0 then
' this is an Access hyperlink; extract the URL part
fp_strVal = Mid(fp_strVal,fp_idxHash1+1)
if Right(fp_strVal,1) = "#" then
fp_strVal = Left(fp_strVal,Len(fp_strVal)-1)
end if
end if
end if
FP_Field = fp_strVal
else
FP_Field = rs(fldname)
end if
Case Else
FP_Field = rs(fldname)
End Select
Else
FP_Field = ""
End If

End Function

Function FP_FieldHTML(rs, fldname)

FP_FieldHTML = Server.HTMLEncode(FP_Field(rs, fldname))

End Function

Function FP_FieldURL(rs, fldname)

FP_FieldURL = Server.URLEncode(FP_Field(rs, fldname))

End Function

Function FP_FieldLink(rs, fldname)

FP_FieldLink = Replace(FP_Field(rs, fldname), " ", "%20")

End Function

Sub FP_OpenConnection(oConn, sAttrs, sUID, sPWD, fMSAccessReadOnly)

Dim sTmp
Dim sConnStr
Dim fIsAccessDriver

fIsAccessDriver = (InStr(LCase(sAttrs), "microsoft access driver") > 0)
sConnStr = FP_RemoveDriverWithDSN(sAttrs)
sTmp = sConnStr

On Error Resume Next

If fMSAccessReadOnly And fIsAccessDriver Then

sTmp = sTmp & ";Exclusive=1;ReadOnly=1"

Err.Clear
oConn.Open sTmp, sUID, sPWD
If Err.Description = "" Then Exit Sub

End If

Err.Clear
oConn.Open sConnStr, sUID, sPWD

End Sub

Function FP_RemoveDriverWithDSN(sAttrs)

FP_RemoveDriverWithDSN = sAttrs

sDrv = "driver="
sDSN = "dsn="
sLC = LCase(sAttrs)
if InStr(sLC, sDSN) < 1 then exit function

idxFirst = InStr(sLC, sDrv)
if idxFirst < 1 then exit function
idxBeg = idxFirst + Len(sDrv)
if Mid(sLC,idxBeg,1) = "{" then
idxEnd = InStr(idxBeg, sLC, "}")
if idxEnd > 0 and Mid(sLC,idxEnd+1,1) = ";" then
idxEnd = idxEnd + 1
end if
else
idxEnd = InStr(idxBeg, sLC, ";")
end if
if idxEnd < 1 then idxEnd = Len(sLC)

FP_RemoveDriverWithDSN = Left(sAttrs,idxFirst-1) & Mid(sAttrs,idxEnd+1)

End Function

Sub FP_OpenRecordset(rs)

On Error Resume Next
rs.Open

End Sub


Function FP_ReplaceQuoteChars(sQry)

Dim sIn
Dim sOut
Dim idx

sIn = sQry
sOut = ""

idx = InStr(sIn, "%%")

Do While (idx > 0)

sOut = sOut & Left(sIn, idx - 1)
sIn = Mid(sIn, idx + 2)
if (Left(sIn,1) = "%") And (Left(sIn,2) <> "%%") then
sIn = Mid(sIn, 2)
sOut = sOut & "%"
end if
sOut = sOut & "::"

idx = InStr(sIn, "%%")
if idx > 0 then
sOut = sOut & Left(sIn, idx - 1)
sIn = Mid(sIn, idx + 2)
sOut = sOut & "::"
if (Left(sIn,1) = "%") And (Left(sIn,2) <> "%%") then
sIn = Mid(sIn, 2)
sOut = sOut & "%"
end if
end if

idx = InStr(sIn, "%%")

Loop

sOut = sOut & sIn

FP_ReplaceQuoteChars = sOut

End Function

Sub FP_Close(obj)

On Error Resume Next

obj.Close

End Sub

Sub FP_SetCursorProperties(rs)

On Error Resume Next

rs.CursorLocation = 3 ' adUseClient
rs.CursorType = 3 ' adOpenStatic

End Sub
**************************

if not tell me,

Thank's

João Batista
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform