upload + db
Jeg bruger lars snyder's upload ting og har ikke ændret på ret meget, men jeg vil gerne have den til at skrive i databasen samtidig, og det kkan jeg sgu ikke hitte ud af:Fejlmedelse:
Microsoft VBScript runtime error '800a01a8'
Object required: ''
jeg kan se at det her problemet er:
kundeRs("dato") = Upload.form("dato")
kundeRs("tekst") = Upload.form("news")
men hvad skal der så stå??
<%@ Language="VBScript" %>
<% Option Explicit %>
<% Server.ScriptTimeOut =50000 %>
<!-- #include file="adovbs.inc" -->
<!-- #INCLUDE FILE="fileupload.inc" -->
<html>
<head>
<title>Rock ved Søbredden</title>
<!--#include file="style.asp"-->
<SCRIPT LANGUAGE="JavaScript">
<!--
function tjekformular(form1){
if (form1.news.value == "") {alert('Du skal skrive en nyhed for at nyhedssiden kan opdateres');form1.news.focus(); return false;};
if (form1.dato.value == "") {alert('Du skal skrive en dato for at nyhedssiden kan opdateres');form1.dato.focus(); return false;};
}
//-->
</SCRIPT>
</head>
<body bgcolor="#F0F0F0" vlink="#48576C" link="#48576C" alink="#000000">
<!--#include file="menu.asp" -->
</td>
<td width="1" bgcolor="#000000"><img src="../im/clear.gif" height="1" width="1"></td>
<td bgcolor="#FFFFFF" width=100% valign="top" height="200">
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td bgcolor="#B0C4DE" height="15" width="100%"><font face="Verdana" size="1" color="#000000"><b><span style="float: right;"><a href="../main.asp">Tilbage til forsiden</a> </span><span style="text-align:left;"> Ret/Tilføj nyheder</span></b></font></td>
</tr>
<tr>
<td bgcolor="#000000" height="1" width="100%"><img src="../im/clear.gif" height="1" width="1"></td>
</tr>
</table>
<table border="0" cellpadding="2" cellspacing="0" width=100%>
<tr>
<td width="100%"><font face="Verdana" size="1">
<div align="center">
<a href="default.asp">Tilbage til oversigt</a><br>
<%
'*************************************
'**** Test af FileUpload funktion ****
'**** ****
'**** Upload .gif eller .jpg ****
'**** billede til mappen /upload ****
'*************************************
'Skal formen vises?
If Request.ServerVariables("REQUEST_METHOD") <> "POST" Then
%>
<strong>Her kan du oprette en nyhed</strong>
<form METHOD="Post" ENCTYPE="multipart/form-data" ACTION="opret.asp">
Du tilføjer link ved at skrive www.maximilian.dk<br>
Enkel linieafstand laves ved at trykke "shift"+"Enter"<br>
<table width="400">
<tr>
<td>
<div align="left"><font size=1 face="verdana"><b>
Dato: <input type="text" name="dato" size="20" > <strong>Vær opmærksom på at datoen er rigtig!!</strong><br>
<textarea type="text" name="news" rows=8 cols=50 ></textarea>
</b></font></div>
</td>
</tr>
<tr>
<td valign="top" align="center"> <font size=1 face="verdana">
Vedhæft fil:<input type="file" size="30" name="fileupload">
</td>
</tr>
<tr>
<td valign="top" align="center"> <font size=1 face="verdana"><br>
<INPUT NAME="Action" TYPE="submit" VALUE="Upload">
<br>
<strong>Note:</strong><br>
Den dato der bliver vist kan godt rettes senere, men den dato som news bliver sorteret efter bliver oprettet automatisk og kan ikke ændres.<br>
<br>
</td>
</tr>
</table>
</FORM>
<%
Else
Dim intFileUpload, strContentType, strFilename, intFileTotalBytes, dato
intFileUpload = FileUpload("upload/", 200000, Array("image/gif", "image/jpeg", "image/pjpeg", "text/plain", "application/pdf"), Array("gif", "jpg", "txt", "pdf"), strContentType, strFilename, intFileTotalBytes)
If intFileUpload = 0 Then
Response.Write "Filen " & strFilename & " blev uploaded.<BR>"
Response.Write "Det er en fil af typen " & strContentType & " og den fylder " & intFileTotalBytes & " bytes:<BR>"
Response.Write "<IMG SRC=""upload/" & strFilename & """><BR>"
Else
Response.Write "Der opstod en fejl under upload!<BR>"
Response.Write "Fejl nr: " & intFileUpload & "<BR>"
Response.Write "Filnavn: " & strFilename & "<BR>"
Response.Write "Filtype: " & strContentType & "<BR>"
Response.Write "Filstørrelse: " & intFileTotalBytes & "<BR>"
End If
Dim Forbindelse, kundeRs, Query, Upload
Set Forbindelse = Server.CreateObject("ADODB.Connection")
Forbindelse.Open "DBQ="& Server.MapPath("../../rvsdaaatabase.mdb")&";Driver={Microsoft Access Driver (*.mdb)};"
Set kundeRs = Server.CreateObject("ADODB.Recordset")
Query = "SELECT * FROM bestnews order by id"
kundeRs.Open Query, Forbindelse, adOpenStatic, adLockOptimistic
kundeRs.AddNew
kundeRs("dato") = Upload.form("dato")
kundeRs("tekst") = Upload.form("news")
kundeRs("file") = strFilename
kundeRs.Update
kundeRs.Close
Set kundeRs = Nothing
End If
%>
<%
'-------------------- Start: fileupload.inc --------------------
'*** FileUpload ***
'*** af Lars Snyder (pila@mailme.dk) ***
'*** http://www.tipsogtricks-online.dk ***
'*
'* Sprog: VBScript
'*
'* Input:
'* strPath Streng med uploadpath, f.eks. "output/", "/asp/binary/upload/" eller ""
'* intMaxSize Tilladte grænse for filerne filer der uploades. Hvis < 1 er der ingen grænse.
'* arrAcceptType Array med accepterede Content-Type, f.eks. "image/gif", "image/jpeg". Hvis ("") er alle filtyper accepterede.
'* arrAcceptExt Array med sidste dele af filnavne, f.eks. "gif", "jpg" eller "kundennefil.xls". Hvis ("") er alle ext accepterede.
'*
'* Output: 0 hvis filen er uploaded korrekt.
'* 1 Request fra bruger gik galt
'* 2 Content med name="fileupload" blev ikke fundet
'* 3 Ingen filnavn
'* 4 Content-Type accepteres ikke
'* 5 Ext accepteres ikke
'* 6 Filen er for stor
'* 7 Filen blev ikke uploaded korrekt
'* strContentType Den fundne type, f.eks. "image/gif"
'* strFilename Det fundne filnavn, f.eks. "button.gif"
'* intFileTotalBytes Filens samlede størrelse, f.eks. 9853
'*
'* Eksempler på ContentTypes
'* Microsoft IE4 | Netscape NN4 | Beskrivelse
'* "image/gif" | "image/gif" | CompuServe Graphics Interchange (.gif)
'* "image/pjpeg" | "image/jpeg" | JPEG/JFIF Compliant (.jpg | .jif | .jpeg)
'* "application/octet-stream" | "application/msexcel" | Microsoft Excel-regneark (.xls)
'* "application/octet-stream" | "application/msword" | Microsoft Word-dokument (.doc)
'* "text/html" | "text/html" | HTML Document (.htm | .html)
'* "text/plain" | "application/x-unknown-content-type-asp_auto_file" | Active Server Page (.asp)
'* "text/plain" | "text/plain" | Tekstdokument (.txt)
'* "text/plain" | "application/x-unknown-content-type-Excel.CSV" | Separeret fil (.csv)
'* "application/octet-stream" | "application/octet-stream" | Binær fil (.bin)
'* "application/octet-stream" | "application/octet-stream" | Uden kendt filtype (.lol)
'* Bemærk i øvrigt, at
'* a. Der er desværre forskel på den tekst Microsoft og Netscape anvender på samme filtype.
'* b. Microsoft evaulerer ikke kun filens efternavn, men også det faktiske indhold!
Function FileUpload(strPath, intMaxSize, arrAcceptType, arrAcceptExt, ByRef strContentType, ByRef strFilename, ByRef intFileTotalBytes)
'Variable deklaration
Dim intPostTotalBytes, intStartPos, intEndPos, i
Dim bstrPostData, bstrDivider
Dim strTemp, strFileSpec
Dim arrSplit
Dim vbCrLfB
Dim bolStopLoop, bolContentTypeOK, bolExtOK
Dim fs, ts, f
'Sæt returværdier
strContentType = ""
strFilename = ""
intFileTotalBytes = 0
'Check: Er det faktisk POST upload?
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
'Dan vbCrLf som binær streng
vbCrLfB = ChrB(13) & ChrB(10)
'Hent den binære POST fra brugeren
intPostTotalBytes = Request.TotalBytes 'Find antallet af bytes i POST
bstrPostData = Request.BinaryRead(intPostTotalBytes) 'Hent POST til en binær streng
If LenB(bstrPostData) <> intPostTotalBytes Then 'Check: Er antallet af bytes i POST forskelligt fra den binære streng?
'Returner værdi og stop
FileUpload = 1
Exit Function
End If
'Hent delelinien inkl. vbCrLfB (altid hele første linje)
bstrDivider = LeftB(bstrPostData, InStrB(bstrPostData, vbCrLfB) + 1)
'Default StartPos
intStartPos = 1
'Find Content-Disposition hvor name="fileupload"
bolStopLoop = False
Do
'Find starten af denne Content del (umiddelbart efter delelinien)
intStartPos = InStrB(intStartPos, bstrPostData, bstrDivider) + LenB(bstrDivider)
If intStartPos = 0 Then
'Ikke flere Content delere - Returner værdi og stop
FileUpload = 2
Exit Function
End If
'Find slutningen af denne Content del (umiddelbart inden den næste delelinie)
intEndPos = InStrB(intStartPos, bstrPostData, bstrDivider)
If intEndPos = 0 Then
'Ikke flere Content delere - Returner værdi og stop
FileUpload = 2
Exit Function
End If
'Hent denne Content-Disposition (uden vbCrLf)
strTemp = bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos))
'Er fileupload feltet i denne Content-Disposition?
If InStr(LCase(strTemp), "name=""fileupload""") > 0 Then
'Stop løkken her
bolStopLoop = True
Else
'Start igen umiddelbart efter denne Content, men før næste divider
intStartPos = intEndPos
End If
Loop Until bolStopLoop
'Flyt intStartPos til efter Content-Disposition linjen
intStartPos = intStartPos + Len(strTemp) + 2
'Ekstrakt POST filnavnet fra strTemp
arrSplit = Split(strTemp, ";") 'Opdel strTemp ved ;: Content-Disposition: form-data; name="fileupload"; filename="filen.txt"
'Find filnavnet fra filename= array
strTemp = "" 'Værdi ved fejl
For i = 0 To UBound(arrSplit) 'Køres for alle i denne array
If LCase(Left(Trim(arrSplit(i)), 9)) = "filename=" Then 'Står der filename= ?
strTemp = Trim(arrSplit(i))
Exit For
End If
Next
'Afbryd hvis der ikke blev fundet noget filnavn
If strTemp = "" Or strTemp = "filename=""""" Then
FileUpload = 3
Exit Function
End If
'Find filnavnet
arrSplit = Split(strTemp, """") 'Opdel streng ved "
strTemp = arrSplit(UBound(arrSplit) - 1) 'Næstsidste indholder filnavn
arrSplit = Split(strTemp, "\") 'Del ved alle \ Så indeholder den sidste filnavn.ext"
strFilename = arrSplit(UBound(arrSplit)) 'Hent den sidste array, der må være filnavnet
'Dan det fulde outputfilnavn via MapPath
strFileSpec = Server.MapPath(LCase(strPath & strFilename)) 'LCase kan evt fjernes herfra
'Hent Content-Type (uden vbCrLf)
strTemp = bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos))
'Flyt intStartPos til efter Content-Type linjen
intStartPos = intStartPos + Len(strTemp) + 2
'Ekstrakt POST Content-Type
arrSplit = Split(strTemp, " ")
strContentType = arrSplit(UBound(arrSplit))
'Skal Content-Type checkes?
bolContentTypeOK = False
If arrAcceptType(LBound(arrAcceptType)) <> "" Then
For Each strTemp In arrAcceptType
If strContentType = strTemp Then
bolContentTypeOK = True
End If
Next
'Check: Er det en accepteret Content-Type?
If Not bolContentTypeOK Then
'ContentType ikke fundet - Returner værdi og stop
FileUpload = 4
Exit Function
End If
End If
'Skal ekstention checkes?
bolExtOK = False
If arrAcceptExt(LBound(arrAcceptExt)) <> "" Then
For Each strTemp In arrAcceptExt
If LCase(Right(strFilename, Len(strTemp))) = strTemp Then
bolExtOK = True
End If
Next
'Check: Er det en accepteret ekstention?
If Not bolExtOK Then
'Ekstention ikke fundet - Returner værdi og stop
FileUpload = 5
Exit Function
End If
End If
'Find faktiske start/slut på datafilen ved at fjerne foranstillede og efterstillede vbCrLfB
intStartPos = intStartPos + 2
intEndPos = intEndPos - 2
intFileTotalBytes = intEndPos - intStartPos
'Skal filstørrelsen checkes?
If intMaxSize > 0 Then
'Check: Er filen for stor?
If intFileTotalBytes > intMaxSize Then
'Filen er for stor - Returner værdi og stop
FileUpload = 6
Exit Function
End If
End If
'Åbn, skriv og luk outputfilen
Set fs = CreateObject("Scripting.FileSystemObject") 'Filsystem objekt
Set ts = fs.CreateTextFile(strFileSpec, True) 'Åbn outputfil, overskriv evt. eksisterende
For i = intStartPos To intEndPos - 1
ts.Write(Chr(AscB(MidB(bstrPostData, i, 1)))) 'Skriv data eet tegn af gangen
Next
ts.Close 'Luk outputfil
'Check: Blev filen oprettet og har den samme størrelse?
Set f = fs.GetFile(strFileSpec)
If f.Size <> intFileTotalBytes Then
FileUpload = 7
Exit Function
End If
'* Returner OK
FileUpload = 0
End If
End Function
'* Funktion der oversætter en bstr binær streng til en almindelig streng
'* Pas på med 00 værdier, da de fungerer som EOF i en almindelig streng
Function bin2str(bstrBinary)
Dim i
For i = 1 To LenB(bstrBinary)
bin2str = bin2str & Chr(AscB(MidB(bstrBinary, i, 1)))
Next
End Function
'-------------------- Slut: fileupload.inc --------------------
%>
