nicht angemeldet
Versuchs mal hiermit:
<% Response.write ("<body onLoad=""parent.frames[1].location.href='" + cstr(FP_FieldVal(fp_rs,"Internet1")) + "';"">") %>
Wenn ich es jetzt wie ursprünglich mit:
<%Response.write("body onload='parent.frames[1].location.href='" & FP_FieldVal(fp_rs,"Internet1") & "';>'")%>
mache bekomm ich dann folgende Fehlermeldung:
Microsoft VBScript runtime error '800a01a8'
Object required
/_fpclass/fpdblib.inc, line 12
Die Datei dazu sieht so aus:
<%
Function FP_FieldVal(rs, fldname)
FP_FieldVal = Server.HTMLEncode(FP_Field(rs, fldname))
if FP_FieldVal = "" then FP_FieldVal = " "
End 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
%>
Was könnt ich da ändern damit es funktioniert???
Wäre über eine Hilfe sehr dankbar!
Danke
Ciao
Markus