Jeg bruger flg. kode som komponentfri upload
<%
'-------------------- Start: fileupload.inc --------------------
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 --------------------
%>
Og så denne kode til selve upload - husk at <!-- #include file = "fileupload.inc" -->
<%
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then %>
Dim intFileUpload, strContentType, strFilename, intFileTotalBytes
intFileUpload = FileUpload(stitilmappenbil2, 1000000, Array("image/gif", "image/jpeg", "image/pjpeg"), Array("gif", "jpg"), strContentType, strFilename, intFileTotalBytes)
If intFileUpload = 0 Then
%>
Filen <b><%=strFilename%></b> blev uploaded.<br>
<IMG SRC="<%=stitilmappenbil2%><%=strFilename%>"><br>
<%
else
%>
<b>Der opstod en fejl under upload!</b><BR>
Fejl nr: <%=intFileUpload%><BR>
Filnavn: <%=strFilename%><BR>
Filtype: <%=strContentType%><BR>
Filstørrelse: <%=intFileTotalBytes/1024%> kb. (Må kke være over 200 kb.)<BR>
<%
End If
End if
%>
