Prøv disse to filer :
uploadgfx.asp :
<%@ Language="VBScript" %>
<% 'Option Explicit %>
<!-- #INCLUDE file="fileupload.inc" -->
<HTML>
<HEAD>
<TITLE>Upload af billede</TITLE>
<link href="../cbland.css" rel="stylesheet" type="text/css">
</head>
<body>
<%
'Skal formen vises?
If Request.ServerVariables("REQUEST_METHOD") <> "POST" Then
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open MM_cbland_STRING
SQL = "select fnavn from farver where fid="&request("fid")
Response.Write(SQL)
set rs=Conn.Execute( SQL )
fnavn=rs("fnavn")
conn.close
set conn=nothing
%>
<FORM ENCTYPE="multipart/form-data" ACTION="uploadgfx.asp?fid=<%=request("fid")%>" METHOD="POST">
Farve: <%= fnavn %><BR><BR>
<P>Vælg billede:<BR>
<INPUT NAME="fileupload" TYPE="file">
<BR><input name="fid" type="hidden" value="<%=request("fid")%>">
<INPUT NAME="Action" TYPE="submit" VALUE="Upload">
</FORM>
<%
Else
Dim intFileUpload, strContentType, strFilename, intFileTotalBytes,fnavn
intFileUpload = FileUpload("../upload/", 200000, Array("image/gif", "image/jpeg", "image/pjpeg"), Array("gif", "jpg"), 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
End If
%>
</BODY>
</HTML>
fileupload.inc :
<%
'-------------------- Start: fileupload.inc --------------------
'##########################################################
' Modificeret af Thomas Petersen, tp@doller.dk, 2001-08-30
'##########################################################
'*** 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
'* intNewFilename Angiver et evt. andet filnavn til filen, BEMÆRK: Angives uden extension!!!
'*
'* 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!
'###########################################################
' Denne function bruges til at gemme filen i større pakker.
'
' Thomas Petersen, tp@doller.dk, 2001-08-30
'###########################################################
dim intPakkeStr,encUd,intStep,ialt,c
function encodePakke(encInd)
encUd = ""
for c = 1 to lenb(encInd)
encUd = encUd & Chr(AscB(MidB(encInd, c, 1)))
next
encodePakke = encUd
end function
'###########################################################
Function FileUpload(strPath, intMaxSize, arrAcceptType, arrAcceptExt, ByRef strContentType, ByRef strFilename, ByRef intFileTotalBytes, ByRef strNewFilename)
'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
'For i = 0 To UBound(arrSplit)
' response.write arrSplit(i)&"<br>"
'next
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
'#################################################
' Her undersøges om filen skal have et andet navn
'
' Thomas Petersen, tp@doller.dk, 2001-08-30
'#################################################
if strNewFilename <> "" and instr(strFilename, ".") then
strExt = mid(strFilename, instr(strFilename, "."), len(strFilename) - instr(strFilename, ".") + 1)
strNewFilename = strNewFileName & strExt
strFilename = strNewFilename
end if
'#################################################
'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
'####################################################################################################
' Her begynder ny upload funktion. Denne deler filen op i 1Kb stykker, hvis filen er over 1Kb i alt.
' Derved opnåes en højere uploadhastighed.
'
' Thomas Petersen, tp@doller.dk, 2001-08-30
'####################################################################################################
intPakkeStr = 1024
if intFileTotalBytes > intPakkeStr then
intStep = intPakkeStr
else
intStep = intFileTotalBytes
end if
intPakkeStr = intStep
ialt = 0
i = intStartPos
Do Until i > intEndPos - 1
if i + intStep > intEndPos - 1 then
intPakkeStr = intEndPos - i
end if
ialt = ialt + intPakkeStr
ts.Write encodePakke(MidB(bstrPostData, i, intPakkeStr))
i = i + intStep
Loop
'####################################################################################################
ts.Close 'Luk outputfil
'Check: Blev filen oprettet og har den samme størrelse?
Set f = fs.GetFile(strFileSpec)
If f.Size <> intFileTotalBytes Then
response.write f.size
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
Function BinaryToString(Binary)
Dim I, S
For I = 1 To LenB(Binary)
S = S & Chr(AscB(MidB(Binary, I, 1)))
Next
BinaryToString = S
response.write bin2str &"<br>"
response.write Request.BinaryRead("Fnavn")&"<br><br>"
End Function
'-------------------- Slut: fileupload.inc --------------------
%>
Mvh
sMorch
